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 / calendar.itk < prev    next >
Text File  |  1999-02-24  |  31KB  |  939 lines
  1. #
  2. # Calendar
  3. # ----------------------------------------------------------------------
  4. # Implements a calendar widget for the selection of a date.  It displays
  5. # a single month at a time.  Buttons exist on the top to change the 
  6. # month in effect turning th pages of a calendar.  As a page is turned, 
  7. # the dates for the month are modified.  Selection of a date visually 
  8. # marks that date.  The selected value can be monitored via the 
  9. # -command option or just retrieved using the get method.  Methods also
  10. # exist to select a date and show a particular month.  The option set
  11. # allows the calendars appearance to take on many forms.
  12. # ----------------------------------------------------------------------
  13. # AUTHOR:  Mark L. Ulferts             E-mail: mulferts@austin.dsccc.com
  14. #            
  15. # ACKNOWLEDGEMENTS: Michael McLennan   E-mail: mmclennan@lucent.com
  16. #
  17. # This code is an [incr Tk] port of the calendar code shown in Michael 
  18. # J. McLennan's book "Effective Tcl" from Addison Wesley.  Small 
  19. # modificiations were made to the logic here and there to make it a 
  20. # mega-widget and the command and option interface was expanded to make 
  21. # it even more configurable, but the underlying logic is the same.
  22. #
  23. # @(#) $Id: calendar.itk,v 1.1 1998/07/27 18:53:01 stanton Exp $
  24. # ----------------------------------------------------------------------
  25. #            Copyright (c) 1997 DSC Technologies Corporation
  26. # ======================================================================
  27. # Permission to use, copy, modify, distribute and license this software 
  28. # and its documentation for any purpose, and without fee or written 
  29. # agreement with DSC, is hereby granted, provided that the above copyright 
  30. # notice appears in all copies and that both the copyright notice and 
  31. # warranty disclaimer below appear in supporting documentation, and that 
  32. # the names of DSC Technologies Corporation or DSC Communications 
  33. # Corporation not be used in advertising or publicity pertaining to the 
  34. # software without specific, written prior permission.
  35. # 
  36. # DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING 
  37. # ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
  38. # INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
  39. # AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, 
  40. # SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL 
  41. # DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR 
  42. # ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, 
  43. # WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
  44. # ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS 
  45. # SOFTWARE.
  46. # ======================================================================
  47.  
  48. #
  49. # Usual options.
  50. #
  51. itk::usual Calendar {
  52.     keep -background -cursor 
  53. }
  54.  
  55. # ------------------------------------------------------------------
  56. #                            CALENDAR
  57. # ------------------------------------------------------------------
  58. class iwidgets::Calendar {
  59.     inherit itk::Widget
  60.     
  61.     constructor {args} {}
  62.  
  63.     itk_option define -days days Days {Su Mo Tu We Th Fr Sa}
  64.     itk_option define -command command Command {}
  65.     itk_option define -forwardimage forwardImage Image {}
  66.     itk_option define -backwardimage backwardImage Image {}
  67.     itk_option define -weekdaybackground weekdayBackground Background \#d9d9d9
  68.     itk_option define -weekendbackground weekendBackground Background \#d9d9d9
  69.     itk_option define -outline outline Outline \#d9d9d9
  70.     itk_option define -buttonforeground buttonForeground Foreground blue
  71.     itk_option define -foreground foreground Foreground black
  72.     itk_option define -selectcolor selectColor Foreground red
  73.     itk_option define -selectthickness selectThickness SelectThickness 3
  74.     itk_option define -titlefont titleFont Font \
  75.     -*-helvetica-bold-r-normal--*-140-*
  76.     itk_option define -dayfont dayFont Font \
  77.     -*-helvetica-medium-r-normal--*-120-*
  78.     itk_option define -datefont dateFont Font \
  79.     -*-helvetica-medium-r-normal--*-120-*
  80.     itk_option define -currentdatefont currentDateFont Font \
  81.     -*-helvetica-bold-r-normal--*-120-*
  82.     itk_option define -startday startDay Day sunday
  83.  
  84.     public method get {{format "-string"}} ;# Returns the selected date
  85.     public method select {{date_ "now"}}   ;# Selects date, moving select ring
  86.     public method show {{date_ "now"}}     ;# Displays a specific date
  87.  
  88.     protected method _drawtext {canvas_ day_ date_ now_ x0_ y0_ x1_ y1_} 
  89.  
  90.     private method _change {delta_}
  91.     private method _configureHandler {}
  92.     private method _redraw {}
  93.     private method _days {{wmax {}}}
  94.     private method _layout {time_}
  95.     private method _select {date_}
  96.     private method _selectEvent {date_}
  97.     private method _adjustday {day_}
  98.     private method _percentSubst {pattern_ string_ subst_}
  99.  
  100.     private variable _time {}
  101.     private variable _selected {}
  102.     private variable _initialized 0
  103.     private variable _offset 0
  104. }
  105.  
  106. #
  107. # Provide a lowercased access method for the Calendar class.
  108. # 
  109. proc ::iwidgets::calendar {pathName args} {
  110.     uplevel ::iwidgets::Calendar $pathName $args
  111. }
  112.  
  113. #
  114. # Use option database to override default resources of base classes.
  115. #
  116. option add *Calendar.width 200 widgetDefault
  117. option add *Calendar.height 165 widgetDefault
  118.  
  119. # ------------------------------------------------------------------
  120. #                        CONSTRUCTOR
  121. # ------------------------------------------------------------------
  122. body iwidgets::Calendar::constructor {args} {
  123.     #
  124.     # Create the canvas which displays each page of the calendar.
  125.     #
  126.     itk_component add page {
  127.     canvas $itk_interior.page
  128.     } {
  129.     keep -background -cursor -width -height
  130.     }
  131.     pack $itk_component(page) -expand yes -fill both
  132.     
  133.     #
  134.     # Create the forward and backward buttons.  Rather than pack
  135.     # them directly in the hull, we'll waittill later and make
  136.     # them canvas window items.
  137.     #
  138.     itk_component add backward {
  139.     button $itk_component(page).backward \
  140.         -command [code $this _change -1]
  141.     } {
  142.     keep -background -cursor 
  143.     }
  144.  
  145.     itk_component add forward {
  146.     button $itk_component(page).forward \
  147.         -command [code $this _change +1]
  148.     } {
  149.     keep -background -cursor 
  150.     }
  151.  
  152.     #
  153.     # Set the initial time to now.
  154.     #
  155.     set _time [clock seconds]
  156.  
  157.     # 
  158.     # Bind to the configure event which will be used to redraw
  159.     # the calendar and display the month.
  160.     #
  161.     bind $itk_component(page) <Configure> [code $this _configureHandler]
  162.     
  163.     #
  164.     # Evaluate the option arguments.
  165.     #
  166.     eval itk_initialize $args
  167. }
  168.  
  169. # ------------------------------------------------------------------
  170. #                             OPTIONS
  171. # ------------------------------------------------------------------
  172.  
  173. # ------------------------------------------------------------------
  174. # OPTION: -command
  175. #
  176. # Sets the selection command for the calendar.  When the user 
  177. # selects a date on the calendar, the date is substituted in
  178. # place of "%d" in this command, and the command is executed.
  179. # ------------------------------------------------------------------
  180. configbody iwidgets::Calendar::command {}
  181.  
  182. # ------------------------------------------------------------------
  183. # OPTION: -days
  184. #
  185. # The days option takes a list of values to set the text used to display the 
  186. # days of the week header above the dates.  The default value is 
  187. # {Su Mo Tu We Th Fr Sa}.
  188. # ------------------------------------------------------------------
  189. configbody iwidgets::Calendar::days {
  190.     if {$_initialized} {
  191.     if {[$itk_component(page) find withtag days] != {}} {
  192.         $itk_component(page) delete days
  193.         _days
  194.     }
  195.     }
  196. }
  197.  
  198. # ------------------------------------------------------------------
  199. # OPTION: -backwardimage
  200. #
  201. # Specifies a image to be displayed on the backwards calendar 
  202. # button.  If none is specified, a default is provided.
  203. # ------------------------------------------------------------------
  204. configbody iwidgets::Calendar::backwardimage {
  205.  
  206.     #
  207.     # If no image is given, then we'll use the default image.
  208.     #
  209.     if {$itk_option(-backwardimage) == {}} {
  210.  
  211.     #
  212.     # If the default image hasn't yet been created, then we
  213.     # need to create it.
  214.     #
  215.     if {[lsearch [image names] $this-backward] == -1} {
  216.         image create bitmap $this-backward \
  217.             -foreground $itk_option(-buttonforeground) -data {
  218.         #define back_width 16
  219.         #define back_height 16
  220.         static unsigned char back_bits[] = {
  221.             0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0x30, 
  222.             0xe0, 0x38, 0xf0, 0x3c, 0xf8, 0x3e, 0xfc, 0x3f, 
  223.             0xfc, 0x3f, 0xf8, 0x3e, 0xf0, 0x3c, 0xe0, 0x38,
  224.             0xc0, 0x30, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
  225.         }
  226.     }
  227.  
  228.     #
  229.     # Configure the button to use the default image.
  230.     #
  231.     $itk_component(backward) configure -image $this-backward
  232.     
  233.     #
  234.     # Else, an image has been specified.  First, we'll need to make sure
  235.     # the image really exists before configuring the button to use it.  
  236.     # If it doesn't generate an error.
  237.     #
  238.     } else {
  239.     if {[lsearch [image names] $itk_option(-backwardimage)] != -1} {
  240.         $itk_component(backward) configure \
  241.             -image $itk_option(-backwardimage)
  242.     } else {
  243.         error "bad image name \"$itk_option(-backwardimage)\":\
  244.             image does not exist"
  245.     }
  246.  
  247.     #
  248.     # If we previously created a default image, we'll just remove it.
  249.     #
  250.     if {[lsearch [image names] $this-backward] != -1} {
  251.         image delete $this-backward
  252.     }
  253.     }
  254. }
  255.  
  256.  
  257. # ------------------------------------------------------------------
  258. # OPTION: -forwardimage
  259. #
  260. # Specifies a image to be displayed on the forwards calendar 
  261. # button.  If none is specified, a default is provided.
  262. # ------------------------------------------------------------------
  263. configbody iwidgets::Calendar::forwardimage {
  264.  
  265.     #
  266.     # If no image is given, then we'll use the default image.
  267.     #
  268.     if {$itk_option(-forwardimage) == {}} {
  269.  
  270.     #
  271.     # If the default image hasn't yet been created, then we
  272.     # need to create it.
  273.     #
  274.     if {[lsearch [image names] $this-forward] == -1} {
  275.         image create bitmap $this-forward \
  276.             -foreground $itk_option(-buttonforeground) -data {
  277.         #define fwd_width 16
  278.         #define fwd_height 16
  279.         static unsigned char fwd_bits[] = {
  280.             0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x0c, 0x03, 
  281.             0x1c, 0x07, 0x3c, 0x0f, 0x7c, 0x1f, 0xfc, 0x3f, 
  282.             0xfc, 0x3f, 0x7c, 0x1f, 0x3c, 0x0f, 0x1c, 0x07,
  283.             0x0c, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
  284.         }
  285.     }
  286.  
  287.     #
  288.     # Configure the button to use the default image.
  289.     #
  290.     $itk_component(forward) configure -image $this-forward
  291.     
  292.     #
  293.     # Else, an image has been specified.  First, we'll need to make sure
  294.     # the image really exists before configuring the button to use it.  
  295.     # If it doesn't generate an error.
  296.     #
  297.     } else {
  298.     if {[lsearch [image names] $itk_option(-forwardimage)] != -1} {
  299.         $itk_component(forward) configure \
  300.             -image $itk_option(-forwardimage)
  301.     } else {
  302.         error "bad image name \"$itk_option(-forwardimage)\":\
  303.             image does not exist"
  304.     }
  305.  
  306.     #
  307.     # If we previously created a default image, we'll just remove it.
  308.     #
  309.     if {[lsearch [image names] $this-forward] != -1} {
  310.         image delete $this-forward
  311.     }
  312.     }
  313. }
  314.  
  315. # ------------------------------------------------------------------
  316. # OPTION: -weekdaybackground
  317. #
  318. # Specifies the background for the weekdays which allows it to
  319. # be visually distinguished from the weekend.
  320. # ------------------------------------------------------------------
  321. configbody iwidgets::Calendar::weekdaybackground {
  322.     if {$_initialized} {
  323.     $itk_component(page) itemconfigure weekday \
  324.         -fill $itk_option(-weekdaybackground)
  325.     }
  326. }
  327.  
  328. # ------------------------------------------------------------------
  329. # OPTION: -weekendbackground
  330. #
  331. # Specifies the background for the weekdays which allows it to
  332. # be visually distinguished from the weekdays.
  333. # ------------------------------------------------------------------
  334. configbody iwidgets::Calendar::weekendbackground {
  335.     if {$_initialized} {
  336.     $itk_component(page) itemconfigure weekend \
  337.         -fill $itk_option(-weekendbackground)
  338.     }
  339. }
  340.  
  341. # ------------------------------------------------------------------
  342. # OPTION: -foreground
  343. #
  344. # Specifies the foreground color for the textual items, buttons,
  345. # and divider on the calendar.
  346. # ------------------------------------------------------------------
  347. configbody iwidgets::Calendar::foreground {
  348.     if {$_initialized} {
  349.     $itk_component(page) itemconfigure text \
  350.         -fill $itk_option(-foreground)
  351.     $itk_component(page) itemconfigure line \
  352.         -fill $itk_option(-foreground)
  353.     }
  354. }
  355.  
  356. # ------------------------------------------------------------------
  357. # OPTION: -outline
  358. #
  359. # Specifies the outline color used to surround the date text.
  360. # ------------------------------------------------------------------
  361. configbody iwidgets::Calendar::outline {
  362.     if {$_initialized} {
  363.     $itk_component(page) itemconfigure square \
  364.         -outline $itk_option(-outline)
  365.     }
  366. }
  367.  
  368. # ------------------------------------------------------------------
  369. # OPTION: -buttonforeground
  370. #
  371. # Specifies the foreground color of the forward and backward buttons.
  372. # ------------------------------------------------------------------
  373. configbody iwidgets::Calendar::buttonforeground {
  374.     if {$_initialized} {
  375.     if {$itk_option(-forwardimage) == {}} {
  376.         if {[lsearch [image names] $this-forward] != -1} {
  377.         $this-forward configure \
  378.             -foreground $itk_option(-buttonforeground)
  379.         }
  380.     } else {
  381.         $itk_option(-forwardimage) configure \
  382.             -foreground $itk_option(-buttonforeground)
  383.     }
  384.     
  385.     if {$itk_option(-backwardimage) == {}} {
  386.         if {[lsearch [image names] $this-backward] != -1} {
  387.         $this-backward configure \
  388.             -foreground $itk_option(-buttonforeground)
  389.         }
  390.     } else {
  391.         $itk_option(-backwardimage) configure \
  392.             -foreground $itk_option(-buttonforeground)
  393.     }
  394.     }
  395. }
  396.  
  397. # ------------------------------------------------------------------
  398. # OPTION: -selectcolor
  399. #
  400. # Specifies the color of the ring displayed that distinguishes the 
  401. # currently selected date.  
  402. # ------------------------------------------------------------------
  403. configbody iwidgets::Calendar::selectcolor {
  404.     if {$_initialized} {
  405.     $itk_component(page) itemconfigure $_selected-sensor \
  406.         -outline $itk_option(-selectcolor) 
  407.     }
  408. }
  409.  
  410. # ------------------------------------------------------------------
  411. # OPTION: -selectthickness
  412. #
  413. # Specifies the thickness of the ring displayed that distinguishes 
  414. # the currently selected date.  
  415. # ------------------------------------------------------------------
  416. configbody iwidgets::Calendar::selectthickness {
  417.     if {$_initialized} {
  418.     $itk_component(page) itemconfigure $_selected-sensor \
  419.         -width $itk_option(-selectthickness) 
  420.     }
  421. }
  422.  
  423. # ------------------------------------------------------------------
  424. # OPTION: -titlefont
  425. #
  426. # Specifies the font used for the title text that consists of the 
  427. # month and year.
  428. # ------------------------------------------------------------------
  429. configbody iwidgets::Calendar::titlefont {
  430.     if {$_initialized} {
  431.     $itk_component(page) itemconfigure title \
  432.         -font $itk_option(-titlefont)
  433.     }
  434. }
  435.  
  436. # ------------------------------------------------------------------
  437. # OPTION: -datefont
  438. #
  439. # Specifies the font used for the date text that consists of the 
  440. # day of the month.
  441. # ------------------------------------------------------------------
  442. configbody iwidgets::Calendar::datefont {
  443.     if {$_initialized} {
  444.     $itk_component(page) itemconfigure date \
  445.         -font $itk_option(-datefont)
  446.     }
  447. }
  448.  
  449. # ------------------------------------------------------------------
  450. # OPTION: -currentdatefont
  451. #
  452. # Specifies the font used for the current date text.
  453. # ------------------------------------------------------------------
  454. configbody iwidgets::Calendar::currentdatefont {
  455.     if {$_initialized} {
  456.     $itk_component(page) itemconfigure now \
  457.         -font $itk_option(-currentdatefont)
  458.     }
  459. }
  460.  
  461. # ------------------------------------------------------------------
  462. # OPTION: -dayfont
  463. #
  464. # Specifies the font used for the day of the week text.
  465. # ------------------------------------------------------------------
  466. configbody iwidgets::Calendar::dayfont {
  467.     if {$_initialized} {
  468.     $itk_component(page) itemconfigure days \
  469.         -font $itk_option(-dayfont)
  470.     }
  471. }
  472.  
  473. # ------------------------------------------------------------------
  474. # OPTION: -startday
  475. #
  476. # Specifies the starting day for the week.  The value must be a day of the
  477. # week: sunday, monday, tuesday, wednesday, thursday, friday, or
  478. # saturday.  The default is sunday.
  479. # ------------------------------------------------------------------
  480. configbody iwidgets::Calendar::startday {
  481.     set day [string tolower $itk_option(-startday)]
  482.  
  483.     switch $day {
  484.     sunday {set _offset 0}
  485.     monday {set _offset 1}
  486.     tuesday {set _offset 2}
  487.     wednesday {set _offset 3}
  488.     thursday {set _offset 4}
  489.     friday {set _offset 5}
  490.     saturday {set _offset 6}
  491.     default {
  492.         error "bad startday option \"$itk_option(-startday)\":\
  493.                    should be sunday, monday, tuesday, wednesday,\
  494.                    thursday, friday, or saturday"
  495.     }
  496.     }
  497.  
  498.     if {$_initialized} {
  499.     $itk_component(page) delete all-page
  500.     _redraw
  501.     }
  502. }
  503.  
  504. # ------------------------------------------------------------------
  505. #                            METHODS
  506. # ------------------------------------------------------------------
  507.  
  508. # ------------------------------------------------------------------
  509. # PUBLIC METHOD: get ?format?
  510. #
  511. # Returns the currently selected date in one of two formats, string 
  512. # or as an integer clock value using the -string and -clicks
  513. # options respectively.  The default is by string.  Reference the 
  514. # clock command for more information on obtaining dates and their 
  515. # formats.
  516. # ------------------------------------------------------------------
  517. body iwidgets::Calendar::get {{format "-string"}} {
  518.     switch -- $format {
  519.     "-string" {
  520.         return $_selected
  521.     }
  522.     "-clicks" {
  523.         return [clock scan $_selected]
  524.     }
  525.     default {
  526.         error "bad format option \"$format\":\
  527.                    should be -string or -clicks"
  528.     }
  529.     }
  530. }
  531.  
  532. # ------------------------------------------------------------------
  533. # PUBLIC METHOD: select date_
  534. #
  535. # Changes the currently selected date to the value specified.
  536. # ------------------------------------------------------------------
  537. body iwidgets::Calendar::select {{date_ "now"}} {
  538.     if {$date_ == "now"} {
  539.     set time [clock seconds]
  540.     } else {
  541.     if {[catch {clock format $date_}] == 0} {
  542.         set time $date_
  543.     } elseif {[catch {set time [clock scan $date_]}] != 0} {
  544.         error "bad date: \"$date_\", must be a valid date string, clock clicks value or the keyword now"
  545.     }
  546.     }
  547.  
  548.     _select [clock format $time -format "%m/%d/%Y"]
  549. }
  550.  
  551. # ------------------------------------------------------------------
  552. # PUBLIC METHOD: show date_
  553. #
  554. # Changes the currently display month to be that of the specified 
  555. # date.
  556. # ------------------------------------------------------------------
  557. body iwidgets::Calendar::show {{date_ "now"}} {
  558.     if {$date_ == "now"} {
  559.     set _time [clock seconds]
  560.     } else {
  561.     if {[catch {clock format $date_}] == 0} {
  562.         set _time $date_
  563.     } elseif {[catch {set _time [clock scan $date_]}] != 0} {
  564.         error "bad date: \"$date_\", must be a valid date string, clock clicks value or the keyword now"
  565.     }
  566.     }
  567.  
  568.     $itk_component(page) delete all-page
  569.     _redraw
  570. }
  571.  
  572. # ------------------------------------------------------------------
  573. # PROTECTED METHOD: _drawtext canvas_ day_ date_ now_
  574. #                             x0_ y0_ x1_ y1_
  575. #
  576. # Draws the text in the date square.  The method is protected such that
  577. # it can be overridden in derived classes that may wish to add their
  578. # own unique text.  The method receives the day to draw along with
  579. # the coordinates of the square.
  580. # ------------------------------------------------------------------
  581. body iwidgets::Calendar::_drawtext {canvas_ day_ date_ now_ x0_ y0_ x1_ y1_} {
  582.     set item [$canvas_ create text \
  583.           [expr (($x1_ - $x0_) / 2) + $x0_] \
  584.           [expr (($y1_ -$y0_) / 2) + $y0_ + 1] \
  585.           -anchor center -text "$day_" \
  586.           -fill $itk_option(-foreground)]
  587.  
  588.     if {$date_ == $now_} {
  589.     $canvas_ itemconfigure $item \
  590.         -font $itk_option(-currentdatefont) \
  591.         -tags [list all-page date text now]
  592.     } else {
  593.     $canvas_ itemconfigure $item \
  594.         -font $itk_option(-datefont) \
  595.         -tags [list all-page date text]
  596.     }
  597. }
  598.  
  599. # ------------------------------------------------------------------
  600. # PRIVATE METHOD: _configureHandler
  601. #
  602. # Processes a configure event received on the canvas.  The method
  603. # deletes all the current canvas items and forces a redraw.
  604. # ------------------------------------------------------------------
  605. body iwidgets::Calendar::_configureHandler {} {
  606.     set _initialized 1
  607.  
  608.     $itk_component(page) delete all
  609.     _redraw
  610. }
  611.  
  612. # ------------------------------------------------------------------
  613. # PRIVATE METHOD: _change delta_
  614. #
  615. # Changes the current month displayed in the calendar, moving
  616. # forward or backward by <delta_> months where <delta_> is +/-
  617. # some number.
  618. # ------------------------------------------------------------------
  619. body iwidgets::Calendar::_change {delta_} {
  620.     set dir [expr ($delta_ > 0) ? 1 : -1]
  621.     set month [clock format $_time -format "%m"]
  622.     set month [string trimleft $month 0]
  623.     set year [clock format $_time -format "%Y"]
  624.  
  625.     for {set i 0} {$i < abs($delta_)} {incr i} {
  626.         incr month $dir
  627.         if {$month < 1} {
  628.             set month 12
  629.             incr year -1
  630.         } elseif {$month > 12} {
  631.             set month 1
  632.             incr year 1
  633.         }
  634.     }
  635.     if {[catch {set _time [clock scan "$month/1/$year"]}]} {
  636.     bell
  637.     } else {
  638.     _redraw 
  639.     }
  640. }
  641.  
  642. # ------------------------------------------------------------------
  643. # PRIVATE METHOD: _redraw
  644. #
  645. # Redraws the calendar.  This method is invoked whenever the 
  646. # calendar changes size or we need to effect a change such as draw
  647. # it with a new month.
  648. # ------------------------------------------------------------------
  649. body iwidgets::Calendar::_redraw {} {
  650.     #
  651.     # Remove all the items that typically change per redraw request
  652.     # such as the title and dates.  Also, get the maximum width and
  653.     # height of the page.
  654.     #
  655.     $itk_component(page) delete all-page
  656.  
  657.     set wmax [winfo width $itk_component(page)]
  658.     set hmax [winfo height $itk_component(page)]
  659.  
  660.     #
  661.     # If we haven't yet created the forward and backwards buttons,
  662.     # then dot it; otherwise, skip it.
  663.     #
  664.     if {[$itk_component(page) find withtag button] == {}} {
  665.     $itk_component(page) create window 3 3 -anchor nw \
  666.         -window $itk_component(backward) -tags button
  667.     $itk_component(page) create window [expr $wmax-3] 3 -anchor ne \
  668.         -window $itk_component(forward) -tags button
  669.     }
  670.  
  671.     #
  672.     # Create the title centered between the buttons.
  673.     #
  674.     foreach {x0 y0 x1 y1} [$itk_component(page) bbox button] {
  675.     set x [expr (($x1-$x0)/2)+$x0]
  676.     set y [expr (($y1-$y0)/2)+$y0]
  677.     }
  678.  
  679.     set title [clock format $_time -format "%B %Y"]
  680.     $itk_component(page) create text $x $y -anchor center \
  681.         -text $title -font $itk_option(-titlefont) \
  682.     -fill $itk_option(-foreground) \
  683.     -tags [list title text all-page]
  684.  
  685.     #
  686.     # Add the days of the week labels if they haven't yet been created.
  687.     #
  688.     if {[$itk_component(page) find withtag days] == {}} {
  689.     _days $wmax
  690.     }
  691.  
  692.     #
  693.     # Add a line between the calendar header and the dates if needed.
  694.     #
  695.     set bottom [expr [lindex [$itk_component(page) bbox all] 3] + 3]
  696.  
  697.     if {[$itk_component(page) find withtag line] == {}} {
  698.     $itk_component(page) create line 0 $bottom $wmax $bottom \
  699.         -width 2 -tags line
  700.     }
  701.  
  702.     incr bottom 3
  703.  
  704.     #
  705.     # Get the layout for the time value and create the date squares.
  706.     # This includes the surrounding date rectangle, the date text,
  707.     # and the sensor.  Bind selection to the sensor.
  708.     #
  709.     set current ""
  710.     set now [clock format [clock seconds] -format "%m/%d/%Y"]
  711.  
  712.     set layout [_layout $_time]
  713.     set weeks [expr [lindex $layout end] + 1]
  714.  
  715.     foreach {day date kind dcol wrow} $layout {
  716.         set x0 [expr $dcol*($wmax-7)/7+3]
  717.         set y0 [expr $wrow*($hmax-$bottom-4)/$weeks+$bottom]
  718.         set x1 [expr ($dcol+1)*($wmax-7)/7+3]
  719.         set y1 [expr ($wrow+1)*($hmax-$bottom-4)/$weeks+$bottom]
  720.  
  721.         if {$date == $_selected} {
  722.             set current $date
  723.         }
  724.  
  725.     #
  726.     # Create the rectangle that surrounds the date and configure
  727.     # its background based on the wheather it is a weekday or
  728.     # a weekend.
  729.     #
  730.     set item [$itk_component(page) create rectangle $x0 $y0 $x1 $y1 \
  731.         -outline $itk_option(-outline)]
  732.  
  733.     if {$kind == "weekend"} {
  734.         $itk_component(page) itemconfigure $item \
  735.             -fill $itk_option(-weekendbackground) \
  736.             -tags [list all-page square weekend]
  737.     } else {
  738.         $itk_component(page) itemconfigure $item \
  739.             -fill $itk_option(-weekdaybackground) \
  740.             -tags [list all-page square weekday]
  741.     }
  742.  
  743.     #
  744.     # Create the date text and configure its font based on the 
  745.     # wheather or not it is the current date.
  746.     #
  747.     _drawtext $itk_component(page) $day $date $now $x0 $y0 $x1 $y1
  748.  
  749.     #
  750.     # Create a sensor area to detect selections.  Bind the 
  751.     # sensor and pass the date to the bind script.
  752.     #
  753.         $itk_component(page) create rectangle $x0 $y0 $x1 $y1 \
  754.             -outline "" -fill "" \
  755.             -tags [list $date-sensor all-sensor all-page]
  756.  
  757.         $itk_component(page) bind $date-sensor <ButtonPress-1> \
  758.             [code $this _selectEvent $date]
  759.     }
  760.  
  761.     #
  762.     # Highlight the selected date if it is on this page.
  763.     #
  764.     if {$current != ""} {
  765.         $itk_component(page) itemconfigure $current-sensor \
  766.             -outline $itk_option(-selectcolor) \
  767.         -width $itk_option(-selectthickness)
  768.  
  769.         $itk_component(page) raise $current-sensor
  770.  
  771.     } elseif {$_selected == ""} {
  772.         set date [clock format $_time -format "%m/%d/%Y"]
  773.         _select $date
  774.     }
  775. }
  776.  
  777. # ------------------------------------------------------------------
  778. # PRIVATE METHOD: _days
  779. #
  780. # Used to rewite the days of the week label just below the month 
  781. # title string.  The days are given in the -days option.
  782. # ------------------------------------------------------------------
  783. body iwidgets::Calendar::_days {{wmax {}}} {
  784.     if {$wmax == {}} {
  785.     set wmax [winfo width $itk_component(page)]
  786.     }
  787.  
  788.     set col 0
  789.     set bottom [expr [lindex [$itk_component(page) bbox title buttons] 3] + 7]
  790.  
  791.     foreach dayoweek $itk_option(-days) {
  792.     set x0 [expr $col*($wmax/7)]
  793.     set x1 [expr ($col+1)*($wmax/7)]
  794.  
  795.     $itk_component(page) create text \
  796.         [expr (($x1 - $x0) / 2) + $x0] $bottom \
  797.         -anchor n -text "$dayoweek" \
  798.         -fill $itk_option(-foreground) \
  799.         -font $itk_option(-dayfont) \
  800.         -tags [list days text]
  801.  
  802.     incr col
  803.     }
  804. }
  805.  
  806. # ------------------------------------------------------------------
  807. # PRIVATE METHOD: _layout time_
  808. #
  809. # Used whenever the calendar is redrawn.  Finds the month containing
  810. # a <time_> in seconds, and returns a list for all of the days in 
  811. # that month.  The list looks like this:
  812. #
  813. #    {day1 date1 kind1 c1 r1  day2 date2 kind2 c2 r2  ...}
  814. #
  815. # where dayN is a day number like 1,2,3,..., dateN is the date for
  816. # dayN, kindN is the day type of weekday or weekend, and cN,rN 
  817. # are the column/row indices for the square containing that date.
  818. # ------------------------------------------------------------------
  819. body iwidgets::Calendar::_layout {time_} {
  820.     set month [clock format $time_ -format "%m"]
  821.     set year  [clock format $time_ -format "%Y"]
  822.  
  823.     foreach lastday {31 30 29 28} {
  824.         if {[catch {clock scan "$month/$lastday/$year"}] == 0} {
  825.             break
  826.         }
  827.     }
  828.     set seconds [clock scan "$month/1/$year"]
  829.     set firstday [_adjustday [clock format $seconds -format %w]]
  830.  
  831.     set weeks [expr ceil(double($lastday+$firstday)/7)]
  832.  
  833.     set rlist ""
  834.     for {set day 1} {$day <= $lastday} {incr day} {
  835.         set seconds [clock scan "$month/$day/$year"]
  836.         set date [clock format $seconds -format "%m/%d/%Y"]
  837.     set dayoweek [clock format $seconds -format %w]
  838.  
  839.     if {$dayoweek == 0 || $dayoweek == 6} {
  840.         set kind "weekend"
  841.     } else {
  842.         set kind "weekday"
  843.     }
  844.  
  845.         set daycol [_adjustday $dayoweek]
  846.  
  847.         set weekrow [expr ($firstday+$day-1)/7]
  848.         lappend rlist $day $date $kind $daycol $weekrow 
  849.     }
  850.     return $rlist
  851. }
  852.  
  853. # ------------------------------------------------------------------
  854. # PRIVATE METHOD: _adjustday day_
  855. #
  856. # Modifies the day to be in accordance with the startday option.
  857. # ------------------------------------------------------------------
  858. body iwidgets::Calendar::_adjustday {day_} {
  859.     set retday [expr $day_ - $_offset]
  860.  
  861.     if {$retday < 0} {
  862.     set retday [expr $retday + 7]
  863.     }
  864.  
  865.     return $retday
  866. }
  867.  
  868. # ------------------------------------------------------------------
  869. # PRIVATE METHOD: _select date_
  870. #
  871. # Selects the current <date_> on the calendar.  Highlights the date 
  872. # on the calendar, and executes the command associated with the 
  873. # calendar, with the selected date substituted in place of "%d".
  874. # ------------------------------------------------------------------
  875. body iwidgets::Calendar::_select {date_} {
  876.     set time [clock scan $date_]
  877.     set date [clock format $time -format "%m/%d/%Y"]
  878.  
  879.     set _selected $date
  880.  
  881.     set current [clock format $_time -format "%m %Y"]
  882.     set selected [clock format $time -format "%m %Y"]
  883.  
  884.     if {$current == $selected} {
  885.         $itk_component(page) itemconfigure all-sensor \
  886.             -outline "" -width 1
  887.  
  888.         $itk_component(page) itemconfigure $date-sensor \
  889.             -outline $itk_option(-selectcolor) \
  890.         -width $itk_option(-selectthickness)
  891.         $itk_component(page) raise $date-sensor
  892.     } else {
  893.         set $_time $time
  894.         _redraw 
  895.     }
  896. }
  897.  
  898. # ------------------------------------------------------------------
  899. # PRIVATE METHOD: _selectEvent date_
  900. #
  901. # Selects the current <date_> on the calendar.  Highlights the date 
  902. # on the calendar, and executes the command associated with the 
  903. # calendar, with the selected date substituted in place of "%d".
  904. # ------------------------------------------------------------------
  905. body iwidgets::Calendar::_selectEvent {date_} {
  906.     _select $date_
  907.  
  908.     if {[string trim $itk_option(-command)] != ""} {
  909.         set cmd $itk_option(-command)
  910.         set cmd [_percentSubst %d $cmd [get]]
  911.         uplevel #0 $cmd
  912.     }
  913. }
  914.  
  915. # ------------------------------------------------------------------
  916. # PRIVATE METHOD: _percentSubst pattern_ string_ subst_
  917. #
  918. # This command is a "safe" version of regsub, for substituting
  919. # each occurance of <%pattern_> in <string_> with <subst_>.  The
  920. # usual Tcl "regsub" command does the same thing, but also
  921. # converts characters like "&" and "\0", "\1", etc. that may
  922. # be present in the <subst_> string.
  923. #
  924. # Returns <string_> with <subst_> substituted in place of each
  925. # <%pattern_>.
  926. # ------------------------------------------------------------------
  927. body iwidgets::Calendar::_percentSubst {pattern_ string_ subst_} {
  928.     if {![string match %* $pattern_]} {
  929.         error "bad pattern \"$pattern_\": should be %something"
  930.     }
  931.  
  932.     set rval ""
  933.     while {[regexp "(.*)${pattern_}(.*)" $string_ all head tail]} {
  934.         set rval "$subst_$tail$rval"
  935.         set string_ $head
  936.     }
  937.     set rval "$string_$rval"
  938. }
  939.