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