home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 December / PCWorld_2000-12_cd.bin / Komunikace / Comanche / comanche.exe / lib / iwidgets3.0.0 / scripts / datefield.itk < prev    next >
Text File  |  1999-02-24  |  26KB  |  855 lines
  1. #
  2. # Datefield
  3. # ----------------------------------------------------------------------
  4. # Implements a date entry field with adjustable built-in intelligence
  5. # levels.
  6. # ----------------------------------------------------------------------
  7. #   AUTHOR:  Mark L. Ulferts          E-mail: mulferts@austin.dsccc.com
  8. #
  9. #   @(#) $Id: datefield.itk,v 1.1 1998/07/27 18:53:03 stanton Exp $
  10. # ----------------------------------------------------------------------
  11. #            Copyright (c) 1997 DSC Technologies Corporation
  12. # ======================================================================
  13. # Permission to use, copy, modify, distribute and license this software 
  14. # and its documentation for any purpose, and without fee or written 
  15. # agreement with DSC, is hereby granted, provided that the above copyright 
  16. # notice appears in all copies and that both the copyright notice and 
  17. # warranty disclaimer below appear in supporting documentation, and that 
  18. # the names of DSC Technologies Corporation or DSC Communications 
  19. # Corporation not be used in advertising or publicity pertaining to the 
  20. # software without specific, written prior permission.
  21. # 
  22. # DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING 
  23. # ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
  24. # INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
  25. # AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, 
  26. # SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL 
  27. # DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR 
  28. # ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, 
  29. # WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
  30. # ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS 
  31. # SOFTWARE.
  32. # ======================================================================
  33.  
  34. #
  35. # Usual options.
  36. #
  37. itk::usual Datefield {
  38.     keep -background -borderwidth -cursor -foreground -highlightcolor \
  39.      -highlightthickness -labelfont -textbackground -textfont
  40. }
  41.  
  42. # ------------------------------------------------------------------
  43. #                               DATEFIELD
  44. # ------------------------------------------------------------------
  45. class iwidgets::Datefield {
  46.     inherit iwidgets::Labeledwidget 
  47.     
  48.     constructor {args} {}
  49.  
  50.     itk_option define -childsitepos childSitePos Position e
  51.     itk_option define -command command Command {}
  52.     itk_option define -iq iq Iq high
  53.     
  54.     public method get {{format "-string"}}
  55.     public method isvalid {}
  56.     public method show {{date now}}
  57.  
  58.     protected method _backward {}
  59.     protected method _focusIn {}
  60.     protected method _forward {}
  61.     protected method _keyPress {char sym state}
  62.     protected method _lastDay {month year}
  63.     protected method _moveField {direction}
  64.     protected method _setField {field}
  65.     protected method _whichField {}
  66.  
  67.     protected variable _cfield "month"
  68.     protected variable _fields {month day year}
  69. }
  70.  
  71. #
  72. # Provide a lowercased access method for the datefield class.
  73. # 
  74. proc ::iwidgets::datefield {pathName args} {
  75.     uplevel ::iwidgets::Datefield $pathName $args
  76. }
  77.  
  78. #
  79. # Use option database to override default resources of base classes.
  80. #
  81. option add *Datefield.justify center widgetDefault
  82.  
  83. # ------------------------------------------------------------------
  84. #                        CONSTRUCTOR
  85. # ------------------------------------------------------------------
  86. body iwidgets::Datefield::constructor {args} {
  87.     component hull configure -borderwidth 0
  88.     
  89.     #
  90.     # Create an entry field for entering the date.
  91.     #
  92.     itk_component add date {
  93.     entry $itk_interior.date -width 10
  94.     } {
  95.     keep -borderwidth -cursor -exportselection \
  96.         -foreground -highlightcolor -highlightthickness \
  97.         -insertbackground -justify -relief -state
  98.     
  99.     rename -font -textfont textFont Font
  100.     rename -highlightbackground -background background Background
  101.     rename -background -textbackground textBackground Background
  102.     }
  103.  
  104.     #
  105.     # Create the child site widget.
  106.     #
  107.     itk_component add -protected dfchildsite {
  108.     frame $itk_interior.dfchildsite
  109.     } 
  110.     set itk_interior $itk_component(dfchildsite)
  111.     
  112.     #
  113.     # Add datefield event bindings for focus in and keypress events.
  114.     #
  115.     bind $itk_component(date) <FocusIn> [code $this _focusIn]
  116.     bind $itk_component(date) <KeyPress> [code $this _keyPress %A %K %s]
  117.     
  118.     #
  119.     # Disable some mouse button event bindings:
  120.     #   Button Motion
  121.     #   Double-Clicks
  122.     #   Triple-Clicks
  123.     #   Button2
  124.     #
  125.     bind $itk_component(date) <Button1-Motion>    break
  126.     bind $itk_component(date) <Button2-Motion>    break
  127.     bind $itk_component(date) <Double-Button>    break
  128.     bind $itk_component(date) <Triple-Button>    break
  129.     bind $itk_component(date) <2>        break
  130.  
  131.     #
  132.     # Initialize the widget based on the command line options.
  133.     #
  134.     eval itk_initialize $args
  135.  
  136.     #
  137.     # Initialize the date to the current date.
  138.     #
  139.     $itk_component(date) delete 0 end
  140.     $itk_component(date) insert end \
  141.     [clock format [clock seconds] -format "%m/%d/%Y"]
  142. }
  143.  
  144. # ------------------------------------------------------------------
  145. #                             OPTIONS
  146. # ------------------------------------------------------------------
  147.  
  148. # ------------------------------------------------------------------
  149. # OPTION: -childsitepos
  150. #
  151. # Specifies the position of the child site in the widget.  Valid
  152. # locations are n, s, e, and w.
  153. # ------------------------------------------------------------------
  154. configbody iwidgets::Datefield::childsitepos {
  155.     set parent [winfo parent $itk_component(date)]
  156.  
  157.     switch $itk_option(-childsitepos) {
  158.     n {
  159.         grid $itk_component(dfchildsite) -row 0 -column 0 -sticky ew
  160.         grid $itk_component(date) -row 1 -column 0 -sticky nsew
  161.  
  162.         grid rowconfigure $parent 0 -weight 0
  163.         grid rowconfigure $parent 1 -weight 1
  164.         grid columnconfigure $parent 0 -weight 1
  165.         grid columnconfigure $parent 1 -weight 0
  166.     }
  167.     
  168.     e {
  169.         grid $itk_component(dfchildsite) -row 0 -column 1 -sticky ns
  170.         grid $itk_component(date) -row 0 -column 0 -sticky nsew
  171.  
  172.         grid rowconfigure $parent 0 -weight 1
  173.         grid rowconfigure $parent 1 -weight 0
  174.         grid columnconfigure $parent 0 -weight 1
  175.         grid columnconfigure $parent 1 -weight 0
  176.     }
  177.     
  178.     s {
  179.         grid $itk_component(dfchildsite) -row 1 -column 0 -sticky ew
  180.         grid $itk_component(date) -row 0 -column 0 -sticky nsew
  181.  
  182.         grid rowconfigure $parent 0 -weight 1
  183.         grid rowconfigure $parent 1 -weight 0
  184.         grid columnconfigure $parent 0 -weight 1
  185.         grid columnconfigure $parent 1 -weight 0
  186.     }
  187.     
  188.     w {
  189.         grid $itk_component(dfchildsite) -row 0 -column 0 -sticky ns
  190.         grid $itk_component(date) -row 0 -column 1 -sticky nsew
  191.  
  192.         grid rowconfigure $parent 0 -weight 1
  193.         grid rowconfigure $parent 1 -weight 0
  194.         grid columnconfigure $parent 0 -weight 0
  195.         grid columnconfigure $parent 1 -weight 1
  196.     }
  197.     
  198.     default {
  199.         error "bad childsite option\
  200.             \"$itk_option(-childsitepos)\":\
  201.             should be n, e, s, or w"
  202.     }
  203.     }
  204. }
  205.  
  206. # ------------------------------------------------------------------
  207. # OPTION: -command
  208. #
  209. # Command invoked upon detection of return key press event.
  210. # ------------------------------------------------------------------
  211. configbody iwidgets::Datefield::command {}
  212.  
  213. # ------------------------------------------------------------------
  214. # OPTION: -iq
  215. #
  216. # Specifies the level of intelligence to be shown in the actions
  217. # taken by the date field during the processing of keypress events.
  218. # Valid settings include high, average, and low.  With a high iq,
  219. # the date prevents the user from typing in an invalid date.  For 
  220. # example, if the current date is 05/31/1997 and the user changes
  221. # the month to 04, then the day will be instantly modified for them 
  222. # to be 30.  In addition, leap years are fully taken into account.
  223. # With average iq, the month is limited to the values of 01-12, but
  224. # it is possible to type in an invalid day.  A setting of low iq
  225. # instructs the widget to do no validity checking at all during
  226. # date entry.  With both average and low iq levels, it is assumed
  227. # that the validity will be determined at a later time using the
  228. # date's isvalid command.
  229. # ------------------------------------------------------------------
  230. configbody iwidgets::Datefield::iq {
  231.     switch $itk_option(-iq) {
  232.     high - average - low {
  233.     }
  234.     default {
  235.         error "bad iq option \"$itk_option(-iq)\":\
  236.                    should be high, average or low"
  237.     }
  238.     }
  239. }
  240.  
  241. # ------------------------------------------------------------------
  242. #                            METHODS
  243. # ------------------------------------------------------------------
  244.  
  245. # ------------------------------------------------------------------
  246. # PUBLIC METHOD: get ?format?
  247. #
  248. # Return the current contents of the datefield in one of two formats
  249. # string or as an integer clock value using the -string and -clicks
  250. # options respectively.  The default is by string.  Reference the 
  251. # clock command for more information on obtaining dates and their 
  252. # formats.
  253. # ------------------------------------------------------------------
  254. body iwidgets::Datefield::get {{format "-string"}} {
  255.     set datestr [$itk_component(date) get]
  256.  
  257.     switch -- $format {
  258.     "-string" {
  259.         return $datestr
  260.     }
  261.     "-clicks" {
  262.         return [clock scan $datestr]
  263.     }
  264.     default {
  265.         error "bad format option \"$format\":\
  266.                    should be -string or -clicks"
  267.     }
  268.     }
  269. }
  270.  
  271. # ------------------------------------------------------------------
  272. # PUBLIC METHOD: show date
  273. #
  274. # Changes the currently displayed date to be that of the date 
  275. # argument.  The date may be specified either as a string or an
  276. # integer clock value.  Reference the clock command for more 
  277. # information on obtaining dates and their formats.
  278. # ------------------------------------------------------------------
  279. body iwidgets::Datefield::show {{date "now"}} {
  280.     if {$date == "now"} {
  281.     set seconds [clock seconds]
  282.     } else {
  283.     if {[catch {clock format $date}] == 0} {
  284.         set seconds $date
  285.     } elseif {[catch {set seconds [clock scan $date]}] != 0} {
  286.         error "bad date: \"$date\", must be a valid date\
  287.                string, clock clicks value or the keyword now"
  288.     }
  289.     }
  290.  
  291.     $itk_component(date) delete 0 end
  292.     $itk_component(date) insert end [clock format $seconds -format "%m/%d/%Y"]
  293.  
  294.     _setField month
  295.  
  296.     return
  297. }
  298.  
  299. # ------------------------------------------------------------------
  300. # PUBLIC METHOD: isvalid
  301. #
  302. # Returns a boolean indication of the validity of the currently
  303. # displayed date value.  For example, 3/3/1960 is valid whereas
  304. # 02/29/1997 is invalid.
  305. # ------------------------------------------------------------------
  306. body iwidgets::Datefield::isvalid {} {
  307.     if {[catch {clock scan [$itk_component(date) get]}] != 0} {
  308.     return 0
  309.     } else {
  310.     return 1
  311.     }
  312. }
  313.  
  314. # ------------------------------------------------------------------
  315. # PROTECTED METHOD: _focusIn
  316. #
  317. # This method is bound to the <FocusIn> event.  It resets the 
  318. # insert cursor and field settings to be back to their last known
  319. # positions.
  320. # ------------------------------------------------------------------
  321. body iwidgets::Datefield::_focusIn {} {
  322.     _setField $_cfield
  323. }
  324.  
  325. # ------------------------------------------------------------------
  326. # PROTECTED METHOD: _keyPress 
  327. #
  328. # This method is the workhorse of the class.  It is bound to the
  329. # <KeyPress> event and controls the processing of all key strokes.
  330. # ------------------------------------------------------------------
  331. body iwidgets::Datefield::_keyPress {char sym state} {
  332.     #
  333.     #  Determine which field we are in currently.  This is needed
  334.     # since the user may have moved to this position via a mouse
  335.     # selection and so it would not be in the position we last 
  336.     # knew it to be.
  337.     #
  338.     _whichField 
  339.  
  340.     #
  341.     # Set up a few basic variables we'll be needing throughout the
  342.     # rest of the method such as the position of the insert cursor
  343.     # and the currently displayed day, month, and year.
  344.     #
  345.     set icursor [$itk_component(date) index insert]
  346.     set splist [split [$itk_component(date) get] "/"]
  347.     set month [lindex $splist 0]
  348.     set day [lindex $splist 1]
  349.     set year [lindex $splist 2]
  350.  
  351.     #
  352.     # Process numeric keystrokes.  This involes a fair amount of 
  353.     # processing with step one being to check and make sure we
  354.     # aren't attempting to insert more that 10 characters.  If
  355.     # so ring the bell and break.
  356.     #
  357.     if {[regexp {[0-9]} $char]} {
  358.     if {[$itk_component(date) index insert] == 10} {
  359.         bell
  360.         return -code break
  361.     }
  362.  
  363.     #
  364.     # If we are currently in the month field then we process the
  365.         # number entered based on the cursor position.  If we are at
  366.     # at the first position and our iq is low, then accept any 
  367.         # input.  
  368.     #
  369.     if {$_cfield == "month"} {
  370.         if {[$itk_component(date) index insert] == 0} {
  371.         if {$itk_option(-iq) == "low"} {
  372.             $itk_component(date) delete 0
  373.             $itk_component(date) insert 0 $char
  374.  
  375.         } else {            
  376.             
  377.             #
  378.             # Otherwise, we're slightly smarter.  If the number
  379.             # is less than two insert it at position zero.  If 
  380.             # this makes the month greater than twelve, set the 
  381.             # number at position one to zero which makes in 
  382.             # effect puts the month back in range.  
  383.             #
  384.             regsub {([0-9])([0-9])} $month "$char\\2" month2b
  385.  
  386.             if {$char < 2} {
  387.             $itk_component(date) delete 0
  388.             $itk_component(date) insert 0 $char
  389.  
  390.             if {$month2b > 12} {
  391.                 $itk_component(date) delete 1
  392.                 $itk_component(date) insert 1 0
  393.                 $itk_component(date) icursor 1
  394.             } elseif {$month2b == "00"} {
  395.                 $itk_component(date) delete 1
  396.                 $itk_component(date) insert 1 1
  397.                 $itk_component(date) icursor 1
  398.             }                
  399.  
  400.             #
  401.             # Finally, if the number is greater than one we'll 
  402.             # assume that they really mean to be entering a zero
  403.                   # followed by their number, do so for them, and 
  404.             # proceed to skip to the next field which is the 
  405.             # day field.
  406.             #
  407.             } else {
  408.             $itk_component(date) delete 0 2
  409.             $itk_component(date) insert 0 0$char
  410.             _setField day
  411.             }
  412.         }
  413.             
  414.         #
  415.         # Else, we're at cursor position one.  Again, if we aren't
  416.         # too smart, let them enter anything.  Otherwise, if the 
  417.         # number makes the month exceed twelve, set the month to
  418.         # zero followed by their number to get it back into range.
  419.             #
  420.         } else {
  421.         regsub {([0-9])([0-9])} $month "\\1$char" month2b
  422.         
  423.         if {$itk_option(-iq) == "low"} {
  424.             $itk_component(date) delete 1
  425.             $itk_component(date) insert 1 $char
  426.         } else {
  427.             if {$month2b > 12} {
  428.             $itk_component(date) delete 0 2
  429.             $itk_component(date) insert 0 0$char
  430.             } elseif {$month2b == "00"} {
  431.             bell
  432.             return -code break
  433.             } else {
  434.             $itk_component(date) delete 1
  435.             $itk_component(date) insert 1 $char
  436.             }            
  437.         }
  438.         
  439.         _setField day
  440.         }
  441.  
  442.             # 
  443.             # Now, the month processing is complete and if we're of a
  444.         # high level of intelligence, then we'll make sure that the
  445.             # current value for the day is valid for this month.  If
  446.         # it is beyond the last day for this month, change it to
  447.             # be the last day of the new month.
  448.             #
  449.         if {$itk_option(-iq) == "high"} {
  450.         set splist [split [$itk_component(date) get] "/"]
  451.         set month [lindex $splist 0]
  452.  
  453.         if {$day > [set endday [_lastDay $month $year]]} {
  454.             set icursor [$itk_component(date) index insert]
  455.             $itk_component(date) delete 3 5
  456.             $itk_component(date) insert 3 $endday
  457.             $itk_component(date) icursor $icursor
  458.         }
  459.         }
  460.         
  461.         #
  462.         # Finally, return with a code of break to stop any normal
  463.         # processing in that we've done all that is necessary.
  464.         #
  465.         return -code break
  466.     }
  467.  
  468.     #
  469.     # This next block of code is for processing of the day field
  470.     # which is quite similar is strategy to that of the month.
  471.     #
  472.     if {$_cfield == "day"} {
  473.         if {$itk_option(-iq) == "high"} {
  474.         set endofMonth [_lastDay $month $year]
  475.         } else {
  476.         set endofMonth 31
  477.         }
  478.  
  479.         #
  480.         # If we are at the third cursor position we are porcessing 
  481.         # the first character of the day field.  If we have an iq 
  482.         # of low accept any input.
  483.         #
  484.         if {[$itk_component(date) index insert] == 3} {
  485.         if {$itk_option(-iq) == "low"} {
  486.             $itk_component(date) delete 3
  487.             $itk_component(date) insert 3 $char
  488.  
  489.         } else {
  490.  
  491.             #
  492.             # If the day to be is double zero, then make the
  493.             # day be the first.
  494.             #
  495.             regsub {([0-9])([0-9])} $day "$char\\2" day2b
  496.  
  497.             if {$day2b == "00"} {
  498.             $itk_component(date) delete 3 5
  499.             $itk_component(date) insert 3 01
  500.             $itk_component(date) icursor 4
  501.  
  502.             #
  503.             # Otherwise, if the character is less than four 
  504.             # and the month is not Feburary, insert the number 
  505.             # and if this makes the day be beyond the valid 
  506.             # range for this month, than set to be back in 
  507.             # range.  
  508.             #
  509.             } elseif {($char < 4) && ($month != "02")} {
  510.             $itk_component(date) delete 3
  511.             $itk_component(date) insert 3 $char
  512.             
  513.             if {$day2b > $endofMonth} {
  514.                 $itk_component(date) delete 4
  515.                 $itk_component(date) insert 4 0
  516.                 $itk_component(date) icursor 4
  517.             } 
  518.             
  519.             #
  520.             # For Feburary with a number to be entered of 
  521.             # less than three, make sure the number doesn't 
  522.             # make the day be greater than the correct range
  523.             # and if so adjust the input. 
  524.                     #
  525.             } elseif {$char < 3} {
  526.             $itk_component(date) delete 3
  527.             $itk_component(date) insert 3 $char
  528.             
  529.             if {$day2b > $endofMonth} {
  530.                 $itk_component(date) delete 3 5
  531.                 $itk_component(date) insert 3 $endofMonth
  532.                 $itk_component(date) icursor 4
  533.             } 
  534.  
  535.             #
  536.             # Finally, if the number is greater than three,
  537.                     # set the day to be zero followed by the number 
  538.             # entered and proceed to the year field.
  539.                     #
  540.             } else {
  541.             $itk_component(date) delete 3 5
  542.             $itk_component(date) insert 3 0$char
  543.             _setField year
  544.             }
  545.         }
  546.             
  547.         #
  548.         # Else, we're dealing with the second number in the day
  549.         # field.  If we're not too bright accept anything, otherwise
  550.         # if the day is beyond the range for this month or equal to
  551.         # zero then ring the bell.
  552.         #
  553.         } else {
  554.         regsub {([0-9])([0-9])} $day "\\1$char" day2b
  555.  
  556.         if {($itk_option(-iq) != "low") && \
  557.             (($day2b > $endofMonth) || ($day2b == "00"))} {
  558.             bell
  559.         } else {
  560.             $itk_component(date) delete 4
  561.             $itk_component(date) insert 4 $char
  562.             _setField year
  563.         }
  564.         }
  565.  
  566.         #
  567.         # Return with a code of break to prevent normal processing. 
  568.         #
  569.         return -code break
  570.     }
  571.  
  572.     #
  573.     # This month and day we're tough, the code for the year is 
  574.     # comparitively simple.  Accept any input and if we are really
  575.     # sharp, then make sure the day is correct for the month
  576.     # given the year.  In short, handle leap years.
  577.     #
  578.     if {$_cfield == "year"} {
  579.         if {$itk_option(-iq) == "low"} {
  580.         $itk_component(date) delete $icursor
  581.         $itk_component(date) insert $icursor $char
  582.         } else {
  583.  
  584.         set prevdate [get]
  585.  
  586.         if {[$itk_component(date) index insert] == 6} {
  587.             set yrdgt [lindex [split [lindex \
  588.                      [split $prevdate "/"] 2] ""] 0]
  589.             if {$char != $yrdgt} {
  590.             if {$char == 1} {
  591.                 $itk_component(date) delete $icursor end
  592.                 $itk_component(date) insert $icursor 1999
  593.             } elseif {$char == 2} {
  594.                 $itk_component(date) delete $icursor end
  595.                 $itk_component(date) insert $icursor 2000
  596.             } else {
  597.                 bell
  598.                 return -code break
  599.             }
  600.             }
  601.  
  602.             $itk_component(date) icursor 7
  603.             return -code break
  604.         }
  605.  
  606.         $itk_component(date) delete $icursor
  607.         $itk_component(date) insert $icursor $char
  608.  
  609.         if {[catch {clock scan [get]}] != 0} {
  610.             $itk_component(date) delete 6 end
  611.             $itk_component(date) insert end \
  612.             [lindex [split $prevdate "/"] 2]
  613.             $itk_component(date) icursor $icursor
  614.  
  615.             bell
  616.             return -code break
  617.         }
  618.  
  619.         if {$itk_option(-iq) == "high"} {
  620.             set splist [split [$itk_component(date) get] "/"]
  621.             set year [lindex $splist 2]
  622.  
  623.             if {$day > [set endday [_lastDay $month $year]]} {
  624.             set icursor [$itk_component(date) index insert]
  625.             $itk_component(date) delete 3 5
  626.             $itk_component(date) insert 3 $endday
  627.             $itk_component(date) icursor $icursor
  628.             }
  629.         }
  630.         }
  631.         
  632.         return -code break
  633.     }
  634.  
  635.     #
  636.     # Process the plus and the up arrow keys.  They both yeild the same
  637.     # effect, they increment the day by one.
  638.     #
  639.     } elseif {($sym == "plus") || ($sym == "Up")} {
  640.     if {[catch {show [clock scan "1 day" -base [get -clicks]]}] != 0} {
  641.         bell
  642.     }
  643.     return -code break
  644.     
  645.     #
  646.     # Process the minus and the down arrow keys which decrement the day.
  647.     #
  648.     } elseif {($sym == "minus") || ($sym == "Down")} {
  649.     if {[catch {show [clock scan "-1 day" -base [get -clicks]]}] != 0} {
  650.         bell
  651.     }
  652.     return -code break
  653.  
  654.     #
  655.     # A tab key moves the day/month/year field forward by one unless
  656.     # the current field is the year.  In that case we'll let tab
  657.     # do what is supposed to and pass the focus onto the next widget.
  658.     #
  659.     } elseif {($sym == "Tab") && ($state == 0)} {
  660.     if {$_cfield != "year"} {
  661.         _moveField forward
  662.         return -code break
  663.     } else {
  664.         _setField "month"
  665.         return -code continue
  666.     }
  667.  
  668.     #
  669.     # A ctrl-tab key moves the day/month/year field backwards by one 
  670.     # unless the current field is the month.  In that case we'll let 
  671.     # tab take the focus to a previous widget.
  672.     #
  673.     } elseif {($sym == "Tab") && ($state == 4)} {
  674.     if {$_cfield != "month"} {
  675.         _moveField backward
  676.         return -code break
  677.     } else {
  678.         set _cfield "month"
  679.         return -code continue
  680.     }
  681.  
  682.     #
  683.     # A right arrow key moves the insert cursor to the right one.
  684.     #
  685.     } elseif {$sym == "Right"} {
  686.     _forward
  687.     return -code break
  688.  
  689.     #
  690.     # A left arrow, backspace, or delete key moves the insert cursor 
  691.     # to the left one.  This is what you expect for the left arrow
  692.     # and since the whole widget always operates in overstrike mode,
  693.     # it makes the most sense for backspace and delete to do the same.
  694.     #
  695.     } elseif {$sym == "Left" || $sym == "BackSpace" || $sym == "Delete"} {
  696.     _backward
  697.     return -code break
  698.  
  699.     } elseif {($sym == "Control_L") || ($sym == "Shift_L") || \
  700.           ($sym == "Control_R") || ($sym == "Shift_R")} {
  701.     return -code break
  702.  
  703.     #
  704.     # A Return key invokes the optionally specified command option.
  705.     #
  706.     } elseif {$sym == "Return"} {
  707.     uplevel #0 $itk_option(-command)
  708.     return -code break 
  709.  
  710.     } else {
  711.     bell
  712.     return -code break
  713.     }
  714. }
  715.  
  716. # ------------------------------------------------------------------
  717. # PROTECTED METHOD: _setField field
  718. #
  719. # Internal method which adjusts the field to be that of the 
  720. # argument, setting the insert cursor appropriately.
  721. # ------------------------------------------------------------------
  722. body iwidgets::Datefield::_setField {field} {
  723.     set _cfield $field
  724.  
  725.     switch $field {
  726.     "month" {
  727.         $itk_component(date) icursor 0
  728.     }
  729.     "day" {
  730.         $itk_component(date) icursor 3
  731.     }
  732.     "year" {
  733.         $itk_component(date) icursor 8
  734.     }
  735.     default {
  736.         error "bad field: \"$field\", must be month, day or year"
  737.     }
  738.     }
  739. }
  740.  
  741. # ------------------------------------------------------------------
  742. # PROTECTED METHOD: _moveField
  743. #
  744. # Internal method for moving the field forward or backward by one.
  745. # ------------------------------------------------------------------
  746. body iwidgets::Datefield::_moveField {direction} {
  747.     set index [lsearch $_fields $_cfield]
  748.  
  749.     if {$direction == "forward"} {
  750.     set newIndex [expr $index + 1]
  751.     } else {
  752.     set newIndex [expr $index - 1]
  753.     }
  754.  
  755.     if {$newIndex == [llength $_fields]} {
  756.     set newIndex 0
  757.     }
  758.     if {$newIndex < 0} {
  759.     set newIndex [expr [llength $_fields] - 1]
  760.     }
  761.  
  762.     _setField [lindex $_fields $newIndex]
  763.  
  764.     return
  765. }
  766.  
  767. # ------------------------------------------------------------------
  768. # PROTECTED METHOD: _whichField
  769. #
  770. # Internal method which returns the current field that the cursor
  771. # is currently within.
  772. # ------------------------------------------------------------------
  773. body iwidgets::Datefield::_whichField {} {
  774.     set icursor [$itk_component(date) index insert]
  775.  
  776.     switch $icursor {
  777.     0 - 1 {
  778.         set _cfield "month"
  779.     }
  780.     3 - 4 {
  781.         set _cfield "day"
  782.     }
  783.     6 - 7 - 8 - 9 {
  784.         set _cfield "year"
  785.     }
  786.     }
  787. }
  788.  
  789. # ------------------------------------------------------------------
  790. # PROTECTED METHOD: _forward
  791. #
  792. # Internal method which moves the cursor forward by one character
  793. # jumping over the slashes and wrapping.
  794. # ------------------------------------------------------------------
  795. body iwidgets::Datefield::_forward {} {
  796.     set icursor [$itk_component(date) index insert]
  797.  
  798.     switch $icursor {
  799.     1 {
  800.         _setField day
  801.     }
  802.     4 {
  803.         _setField year
  804.     }
  805.     9 - 10 {
  806.         _setField month
  807.     }
  808.     default {
  809.         $itk_component(date) icursor [expr $icursor + 1]
  810.     }
  811.     }
  812. }
  813.  
  814. # ------------------------------------------------------------------
  815. # PROTECTED METHOD: _backward
  816. #
  817. # Internal method which moves the cursor backward by one character
  818. # jumping over the slashes and wrapping.
  819. # ------------------------------------------------------------------
  820. body iwidgets::Datefield::_backward {} {
  821.     set icursor [$itk_component(date) index insert]
  822.  
  823.     switch $icursor {
  824.     6 {
  825.         _setField day
  826.     }
  827.     3 {
  828.         _setField month
  829.     }
  830.     0 {
  831.         _setField year
  832.     }
  833.     default {
  834.         $itk_component(date) icursor [expr $icursor -1]
  835.     }
  836.     }
  837. }
  838.  
  839. # ------------------------------------------------------------------
  840. # PROTECTED METHOD: _lastDay month year
  841. #
  842. # Internal method which determines the last day of the month for
  843. # the given month and year.  We start at 28 and go forward till
  844. # we fail.  Crude but effective.
  845. # ------------------------------------------------------------------
  846. body iwidgets::Datefield::_lastDay {month year} {
  847.     set lastone 28
  848.  
  849.     for {set lastone 28} {$lastone < 32} {incr lastone} {
  850.     if {[catch {clock scan $month/[expr $lastone + 1]/$year}] != 0} {
  851.         return $lastone
  852.     }
  853.     }
  854. }
  855.