"Fossies" - the Fresh Open Source Software Archive

Member "ical-tcl/dateeditor.tcl" (15 Apr 2019, 10137 Bytes) of package /linux/privat/ical-3.0.4.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Tcl/Tk source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "dateeditor.tcl" see the Fossies "Dox" file reference documentation.

    1 # Copyright (c) 1993 by Sanjay Ghemawat
    2 ###############################################################################
    3 # DateEditor
    4 #
    5 #       Allows interactive modification of a date.
    6 #
    7 # Description
    8 # ===========
    9 #
   10 # A DateEditor displays a date and allows easy interactive modification
   11 # of the date.  A command is executed whenever the date is modified.
   12 #
   13 # Note
   14 # ====
   15 #
   16 # Code in dateeditor.C depends upon the tags assigned to canvas items.
   17 # If you change the canvas layout, examine dateeditor.C
   18 
   19 # effects - Creates date editor window $name.
   20 #           Initial date is $date.
   21 #           Every time the date is changed, an action is executed to
   22 #           switch "view" to the new date.
   23 
   24 class DateEditor {name date view} {
   25     set slot(window) $name
   26     set slot(date) $date
   27     set slot(view) $view
   28     set slot(offset) 0
   29     set slot(load) 0
   30     set slot(callback) 0
   31     set slot(pending) 0
   32     set slot(itemwidth) 1
   33     set slot(itemheight) 1
   34     set slot(hpad) 2
   35     set slot(vpad) 2
   36 
   37     # Layout the various components
   38     frame $name -class Dateeditor
   39     frame $name.top -class Pane
   40     frame $name.bot
   41     frame $name.mid -class Pane
   42 
   43     # The month selector
   44     frame $name.month
   45     label $name.month.label -text Month\
   46         -anchor center -width 9
   47     button $name.month.left -bitmap left_arrow -relief flat\
   48         -command {ical_last_month}
   49     button $name.month.right -bitmap right_arrow -relief flat\
   50         -command {ical_next_month}
   51 
   52     pack $name.month.left       -side left
   53     pack $name.month.right      -side right
   54     pack $name.month.label      -side left -expand 1 -fill both
   55 
   56     # The year selector
   57     frame $name.year
   58     label $name.year.label -text Year\
   59         -anchor center -width 4
   60     button $name.year.left -bitmap left_arrow -relief flat\
   61         -command {ical_last_year}
   62     button $name.year.right -bitmap right_arrow -relief flat\
   63         -command {ical_next_year}
   64 
   65     pack $name.year.left        -side left
   66     pack $name.year.right       -side right
   67     pack $name.year.label       -side left -expand 1 -fill both
   68 
   69     # Miscellaneous buttons
   70     button $name.last -text Prev\
   71         -command {ical_last_day}
   72     button $name.today -text Today\
   73         -command {ical_today}
   74     button $name.next -text Next\
   75         -command {ical_next_day}
   76 
   77     # The monthday selector
   78     set d $name.days
   79     canvas $d
   80 
   81     # Get dimensions for current date marker
   82     set slot(itemwidth)  [text_width  [pref weekdayFont] " 99"]
   83     set slot(itemheight) [text_height [pref weekdayFont] " 99"]
   84 
   85     # Get heading dimensions
   86     set slot(hw) [text_width  [pref weekdayFont] "Wed" $slot(hpad)]
   87     set slot(hh) [text_height [pref weekdayFont] "Wed" $slot(vpad)]
   88     $d configure -width [expr "$slot(hw)*7+4"] -height [expr "$slot(hh)*8"]
   89 
   90     set x [expr -$slot(hpad)]
   91     set y $slot(vpad)
   92 
   93     # Create monthdays
   94     foreach r {1 2 3 4 5 6} {
   95         foreach c {1 2 3 4 5 6 7} {
   96             $d create text\
   97                 [expr "$x+($c*$slot(hw))"]\
   98                 [expr "$y+(($r+1)*$slot(hh))"]\
   99                 -text "$r$c" -anchor ne\
  100                 -tags [list Day row$r col$c =[expr ($r-1)*7+$c]]\
  101                 -fill [pref weekdayColor]\
  102                 -font [pref weekdayFont]
  103         }
  104     }
  105 
  106     $d bind Day <1> [list $self day_select]
  107 
  108     # Create selection indicator
  109     $d create rect 0 0 5 5 -fill "" -outline [pref weekdayColor]\
  110         -width 2.0 -tags {marker}
  111     $d lower marker Day
  112 
  113     pack $name.month -in $name.top -side left -expand 1 -fill x
  114     pack $name.year  -in $name.top -side left -expand 1 -fill x
  115 
  116     pack $name.last  -in $name.bot -side left  -expand 1 -fill x
  117     pack $name.today -in $name.bot -side left  -expand 1 -fill x
  118     pack $name.next  -in $name.bot -side right -expand 1 -fill x
  119 
  120     pack $d -in $name.mid -side top
  121 
  122     pack $name.top -side top -expand 1 -fill x
  123     pack $name.mid -side top -expand 1 -fill both
  124     pack $name.bot -side top -expand 1 -fill x
  125 
  126     # Setup notification for item changes
  127 
  128     trigger on add      [list de_trigger_set $self]
  129     trigger on change   [list de_trigger_set $self]
  130     trigger on delete   [list de_trigger_set $self]
  131     trigger on flush    [list de_trigger_set $self]
  132     trigger on midnight [list de_trigger_set $self]
  133     trigger on reconfig [list $self reconfig]
  134 
  135     $self reconfig
  136 
  137     $self load_month
  138     $self set_selection
  139 }
  140 
  141 method DateEditor destructor {} {
  142     trigger remove add      [list de_trigger_set $self]
  143     trigger remove change   [list de_trigger_set $self]
  144     trigger remove delete   [list de_trigger_set $self]
  145     trigger remove flush    [list de_trigger_set $self]
  146     trigger remove midnight [list de_trigger_set $self]
  147     trigger remove reconfig [list $self reconfig]
  148 }
  149 
  150 # effects - Set up hilite recalculation to occur after
  151 #           a small delay.  The delay is necessary because various
  152 #           triggers may be fired before the corresponding calendar
  153 #           state is changed.  The delay allows the calendar state
  154 #           to be changed.
  155 proc de_trigger_set {de args} {
  156     after 50 [list de_calc_run $de]
  157 }
  158 
  159 # Wrapper to handle dateeditor deletion
  160 proc de_calc_run {obj} {
  161     if {[info procs $obj] != $obj} {
  162         return
  163     }
  164     $obj calc_hilite
  165 }
  166 
  167 method DateEditor reconfig {} {
  168     set d $slot(window).days
  169     set wnames {Sun Mon Tue Wed Thu Fri Sat}
  170     if [cal option MondayFirst] {
  171         set wnames {Mon Tue Wed Thu Fri Sat Sun}
  172     }
  173 
  174     $d delete Heading
  175     set col 1
  176     foreach w $wnames {
  177         set item [$d create text\
  178                         [expr "$col*$slot(hw)-$slot(hpad)"] $slot(vpad)\
  179                         -text $w -anchor ne\
  180                         -tags [list Heading]\
  181                         -fill [pref weekdayColor]\
  182                         -font [pref weekdayFont]]
  183 
  184         if {($w == "Sun") || ($w == "Sat")} {
  185             $d itemconfigure $item\
  186                 -fill [pref weekendColor]\
  187                 -font [pref weekendFont]
  188         }
  189 
  190         incr col
  191     }
  192 
  193     # Just configure all items to weekdayColor and weekdayFont
  194     $d itemconfigure Day -fill [pref weekdayColor] -font [pref weekdayFont]
  195 
  196     $self load_month
  197     $self set_selection
  198 }
  199 
  200 # effects - Reset dateeditor hilites because of item changes
  201 method DateEditor calc_hilite {} {
  202     set name $slot(window)
  203 
  204     set c1 col7
  205     set c2 col1
  206     if [cal option MondayFirst] {set c2 col6}
  207 
  208     $name.days addtag holiday withtag $c1
  209     $name.days addtag holiday withtag $c2
  210 
  211     # Redo hilite lists
  212     set first [date make 1 [date month $slot(date)] [date year $slot(date)]]
  213     set last  [expr $first + [date monthsize $first] - 1]
  214 
  215     hilite_loop cal {holiday always} $first $last d h {
  216         $name.days addtag $h withtag =[expr [date monthday $d]+$slot(offset)]
  217     }
  218 
  219     canvas_intersect_tags $name.days holiday always holiday+always
  220 
  221     # Change colors
  222     $name.days itemconfig Day\
  223         -fill [pref weekdayColor] -font [pref weekdayFont]
  224 
  225     $name.days itemconfig holiday\
  226         -fill [pref weekendColor] -font [pref weekendFont]
  227 
  228     $name.days itemconfig always\
  229         -fill [pref interestColor] -font [pref interestFont]
  230 
  231     $name.days itemconfig holiday+always\
  232         -fill [pref weekendInterestColor] -font [pref weekendInterestFont]
  233 
  234     $name.days dtag holiday
  235     $name.days dtag always
  236     $name.days dtag holiday+always
  237 }
  238 
  239 # effects - Sets dateeditor contents for new month.
  240 method DateEditor load_month {} {
  241     global month_name
  242 
  243     set date  $slot(date)
  244     set month [date month $date]
  245     set year  [date year  $date]
  246 
  247     set name $slot(window)
  248     $name.month.label configure -text $month_name($month)
  249     $name.year.label configure -text $year
  250 
  251     set first [date make 1 $month $year]
  252     set slot(offset) [expr [date weekday $first]-1]
  253     if [cal option MondayFirst] {
  254         set slot(offset) [expr ($slot(offset)+6)%7]
  255     }
  256 
  257     de_monthdays cal $name.days $date
  258 
  259     # Interest calculation
  260     $self calc_hilite
  261 }
  262 
  263 # effects - Set selection within month
  264 method DateEditor set_selection {} {
  265     # Set selection
  266     set item =[expr [date monthday $slot(date)]+$slot(offset)]
  267 
  268     set name $slot(window)
  269     set coords [$name.days coords $item]
  270     $name.days coords marker\
  271         [expr [lindex $coords 0]+$slot(hpad)]\
  272         [expr [lindex $coords 1]]\
  273         [expr [lindex $coords 0]-$slot(itemwidth)]\
  274         [expr [lindex $coords 1]+$slot(itemheight)]
  275 }
  276 
  277 # Bindings
  278 
  279 method DateEditor day_select {} {
  280     set name $slot(window)
  281     if {[$name.days type current] != "text"} {
  282         return
  283     }
  284 
  285     foreach tag [lindex [$name.days itemconfigure current -tags] 4] {
  286         if [string match "=*" $tag] {
  287             set day [expr [string range $tag 1 end]-$slot(offset)]
  288             if {($day < 1) || ($day > [date monthsize $slot(date)])} {
  289                 return
  290             }
  291             ical_set_date [date make $day\
  292                                [date month $slot(date)]\
  293                                [date year $slot(date)]]
  294             return
  295         }
  296     }
  297 }
  298 
  299 method DateEditor set_date {date} {
  300     set old $slot(date)
  301     if {$old != $date} {
  302         # Make sure date can be rebuilt
  303         if [catch {date make\
  304                        [date monthday $date]\
  305                        [date month $date]\
  306                        [date year $date]} msg] {
  307             return
  308         }
  309 
  310         set slot(date) $date
  311         if {([date month $old] != [date month $date]) ||
  312             ([date year  $old] != [date year  $date])} {
  313             set slot(load) 1
  314         }
  315         set slot(callback) 1
  316         set slot(pending) [expr $slot(pending)+1]
  317         after 50 [list de_check $self]
  318     }
  319 }
  320 
  321 # Wrapper to handle DateEditor deletion
  322 proc de_check {obj} {
  323     if {[info procs $obj] != $obj} {
  324         return
  325     }
  326 
  327     $obj check
  328 }
  329 
  330 method DateEditor check {} {
  331     set slot(pending) [expr $slot(pending)-1]
  332     if {$slot(pending) > 0} {
  333         return
  334     }
  335     set slot(pending) 0
  336 
  337     if $slot(load) {
  338         set slot(load) 0
  339         $self load_month
  340     }
  341 
  342     if $slot(callback) {
  343         set slot(callback) 0
  344         $self set_selection
  345     }
  346 }