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