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 / checkbox.itk < prev    next >
Encoding:
Text File  |  2003-09-01  |  11.8 KB  |  342 lines
  1. #
  2. # Checkbox
  3. # ----------------------------------------------------------------------
  4. # Implements a checkbuttonbox.  Supports adding, inserting, deleting,
  5. # selecting, and deselecting of checkbuttons by tag and index.
  6. #
  7. # ----------------------------------------------------------------------
  8. #  AUTHOR: John A. Tucker                EMAIL: jatucker@spd.dsccc.com
  9. #
  10. # ----------------------------------------------------------------------
  11. #            Copyright (c) 1997 DSC Technologies Corporation
  12. # ======================================================================
  13. # Permission to use, copy, modify, distribute and license this software 
  14. # and its documentation for any purpose, and without fee or written 
  15. # agreement with DSC, is hereby granted, provided that the above copyright 
  16. # notice appears in all copies and that both the copyright notice and 
  17. # warranty disclaimer below appear in supporting documentation, and that 
  18. # the names of DSC Technologies Corporation or DSC Communications 
  19. # Corporation not be used in advertising or publicity pertaining to the 
  20. # software without specific, written prior permission.
  21. # 
  22. # DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING 
  23. # ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
  24. # INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
  25. # AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, 
  26. # SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL 
  27. # DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR 
  28. # ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, 
  29. # WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
  30. # ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS 
  31. # SOFTWARE.
  32. # ======================================================================
  33.  
  34.  
  35. #
  36. # Use option database to override default resources of base classes.
  37. #
  38. option add *Checkbox.labelMargin    10    widgetDefault
  39. option add *Checkbox.labelFont     \
  40.       "-Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*"  widgetDefault
  41. option add *Checkbox.labelPos        nw    widgetDefault
  42. option add *Checkbox.borderWidth    2    widgetDefault
  43. option add *Checkbox.relief        groove    widgetDefault
  44.  
  45. #
  46. # Usual options.
  47. #
  48. itk::usual Checkbox {
  49.     keep -background -borderwidth -cursor -foreground -labelfont
  50. }
  51.  
  52. # ------------------------------------------------------------------
  53. #                            CHECKBOX
  54. # ------------------------------------------------------------------
  55. itcl::class iwidgets::Checkbox {
  56.     inherit iwidgets::Labeledframe
  57.  
  58.     constructor {args} {}
  59.  
  60.     itk_option define -orient orient Orient vertical
  61.  
  62.     public {
  63.       method add {tag args}
  64.       method insert {index tag args}
  65.       method delete {index}
  66.       method get {{index ""}}
  67.       method index {index}
  68.       method select {index}
  69.       method deselect {index}
  70.       method flash {index}
  71.       method toggle {index}
  72.       method buttonconfigure {index args}
  73.   }
  74.  
  75.   private {
  76.  
  77.       method gettag {index}      ;# Get the tag of the checkbutton associated
  78.                                  ;# with a numeric index
  79.  
  80.       variable _unique 0         ;# Unique id for choice creation.
  81.       variable _buttons {}       ;# List of checkbutton tags.
  82.       common buttonVar           ;# Array of checkbutton "-variables"
  83.   }
  84. }
  85.  
  86. #
  87. # Provide a lowercased access method for the Checkbox class.
  88. #
  89. proc ::iwidgets::checkbox {pathName args} {
  90.     uplevel ::iwidgets::Checkbox $pathName $args
  91. }
  92.  
  93. # ------------------------------------------------------------------
  94. #                        CONSTRUCTOR
  95. # ------------------------------------------------------------------
  96. itcl::body iwidgets::Checkbox::constructor {args} {
  97.  
  98.     eval itk_initialize $args
  99. }
  100.  
  101. # ------------------------------------------------------------------
  102. #                            OPTIONS
  103. # ------------------------------------------------------------------
  104.  
  105. # ------------------------------------------------------------------
  106. # OPTION: -orient
  107. #
  108. # Allows the user to orient the checkbuttons either horizontally
  109. # or vertically.  Added by Chad Smith (csmith@adc.com) 3/10/00.
  110. # ------------------------------------------------------------------
  111. itcl::configbody iwidgets::Checkbox::orient {
  112.   if {$itk_option(-orient) == "horizontal"} {
  113.     foreach tag $_buttons {
  114.       pack $itk_component($tag) -side left -anchor nw -padx 4 -expand 1
  115.     }
  116.   } elseif {$itk_option(-orient) == "vertical"} {
  117.     foreach tag $_buttons {
  118.       pack $itk_component($tag) -side top -anchor w -padx 4 -expand 0
  119.     }
  120.   } else {
  121.     error "Bad orientation: $itk_option(-orient).  Should be\
  122.       \"horizontal\" or \"vertical\"."
  123.   }
  124. }
  125.  
  126.  
  127. # ------------------------------------------------------------------
  128. #                            METHODS
  129. # ------------------------------------------------------------------
  130.  
  131. # ------------------------------------------------------------------
  132. # METHOD: index index
  133. #
  134. # Searches the checkbutton tags in the checkbox for the one with the
  135. # requested tag, numerical index, or keyword "end".  Returns the 
  136. # choices's numerical index if found, otherwise error.
  137. # ------------------------------------------------------------------
  138. itcl::body iwidgets::Checkbox::index {index} {
  139.     if {[llength $_buttons] > 0} {
  140.         if {[regexp {(^[0-9]+$)} $index]} {
  141.             if {$index < [llength $_buttons]} {
  142.                 return $index
  143.             } else {
  144.                 error "Checkbox index \"$index\" is out of range"
  145.             }
  146.  
  147.         } elseif {$index == "end"} {
  148.             return [expr {[llength $_buttons] - 1}]
  149.  
  150.         } else {
  151.             if {[set idx [lsearch $_buttons $index]] != -1} {
  152.                 return $idx
  153.             }
  154.  
  155.             error "bad Checkbox index \"$index\": must be number, end,\
  156.                     or pattern"
  157.         }
  158.  
  159.     } else {
  160.         error "Checkbox \"$itk_component(hull)\" has no checkbuttons"
  161.     }
  162. }
  163.  
  164. # ------------------------------------------------------------------
  165. # METHOD: add tag ?option value option value ...?
  166. #
  167. # Add a new tagged checkbutton to the checkbox at the end.  The method 
  168. # takes additional options which are passed on to the checkbutton
  169. # constructor.  These include most of the typical checkbutton 
  170. # options.  The tag is returned.
  171. # ------------------------------------------------------------------
  172. itcl::body iwidgets::Checkbox::add {tag args} {
  173.     itk_component add $tag {
  174.         eval checkbutton $itk_component(childsite).cb[incr _unique] \
  175.             -variable [list [itcl::scope buttonVar($this,$tag)]] \
  176.             -anchor w \
  177.             -justify left \
  178.             -highlightthickness 0 \
  179.             $args
  180.     } { 
  181.       usual
  182.       keep -command -disabledforeground -selectcolor -state
  183.       ignore -highlightthickness -highlightcolor
  184.       rename -font -labelfont labelFont Font
  185.     }
  186.  
  187.     # Redraw the buttons with the proper orientation.
  188.     if {$itk_option(-orient) == "vertical"} {
  189.       pack $itk_component($tag) -side top -anchor w -padx 4 -expand 0
  190.     } else {
  191.       pack $itk_component($tag) -side left -anchor nw -expand 1
  192.     }
  193.  
  194.     lappend _buttons $tag
  195.  
  196.     return $tag
  197. }
  198.  
  199. # ------------------------------------------------------------------
  200. # METHOD: insert index tag ?option value option value ...?
  201. #
  202. # Insert the tagged checkbutton in the checkbox just before the 
  203. # one given by index.  Any additional options are passed on to the
  204. # checkbutton constructor.  These include the typical checkbutton
  205. # options.  The tag is returned.
  206. # ------------------------------------------------------------------
  207. itcl::body iwidgets::Checkbox::insert {index tag args} {
  208.     itk_component add $tag {
  209.         eval checkbutton $itk_component(childsite).cb[incr _unique] \
  210.             -variable [list [itcl::scope buttonVar($this,$tag)]] \
  211.             -anchor w \
  212.             -justify left \
  213.             -highlightthickness 0 \
  214.             $args
  215.     }  { 
  216.       usual
  217.       ignore -highlightthickness -highlightcolor
  218.       rename -font -labelfont labelFont Font
  219.     }
  220.  
  221.     set index [index $index]
  222.     set before [lindex $_buttons $index]
  223.     set _buttons [linsert $_buttons $index $tag]
  224.  
  225.     pack $itk_component($tag) -anchor w -padx 4 -before $itk_component($before)
  226.  
  227.     return $tag
  228. }
  229.  
  230. # ------------------------------------------------------------------
  231. # METHOD: delete index
  232. #
  233. # Delete the specified checkbutton.
  234. # ------------------------------------------------------------------
  235. itcl::body iwidgets::Checkbox::delete {index} {
  236.  
  237.     set tag [gettag $index]
  238.     set index [index $index]
  239.     destroy $itk_component($tag)
  240.     set _buttons [lreplace $_buttons $index $index]
  241.  
  242.     if { [info exists buttonVar($this,$tag)] == 1 } {
  243.     unset buttonVar($this,$tag)
  244.     }
  245. }
  246.  
  247. # ------------------------------------------------------------------
  248. # METHOD: select index
  249. #
  250. # Select the specified checkbutton.
  251. # ------------------------------------------------------------------
  252. itcl::body iwidgets::Checkbox::select {index} {
  253.     set tag [gettag $index]
  254.     #-----------------------------------------------------------
  255.     # BUG FIX: csmith (Chad Smith: csmith@adc.com), 3/30/99
  256.     #-----------------------------------------------------------
  257.     # This method should only invoke the checkbutton if it's not
  258.     # already selected.  Check its associated variable, and if
  259.     # it's set, then just ignore and return.
  260.     #-----------------------------------------------------------
  261.     if {[set [itcl::scope buttonVar($this,$tag)]] == 
  262.     [[component $tag] cget -onvalue]} {
  263.       return
  264.     }
  265.     $itk_component($tag) invoke
  266. }
  267.  
  268. # ------------------------------------------------------------------
  269. # METHOD: toggle index
  270. #
  271. # Toggle a specified checkbutton between selected and unselected
  272. # ------------------------------------------------------------------
  273. itcl::body iwidgets::Checkbox::toggle {index} {
  274.     set tag [gettag $index]
  275.     $itk_component($tag) toggle
  276. }
  277.  
  278. # ------------------------------------------------------------------
  279. # METHOD: get
  280. #
  281. # Return the value of the checkbutton with the given index, or a
  282. # list of all checkbutton values in increasing order by index.
  283. # ------------------------------------------------------------------
  284. itcl::body iwidgets::Checkbox::get {{index ""}} {
  285.     set result {}
  286.  
  287.     if {$index == ""} {
  288.     foreach tag $_buttons {
  289.         if {$buttonVar($this,$tag)} {
  290.         lappend result $tag
  291.         }
  292.     }
  293.     } else {
  294.         set tag [gettag $index]
  295.     set result $buttonVar($this,$tag)
  296.     }
  297.  
  298.     return $result
  299. }
  300.  
  301. # ------------------------------------------------------------------
  302. # METHOD: deselect index
  303. #
  304. # Deselect the specified checkbutton.
  305. # ------------------------------------------------------------------
  306. itcl::body iwidgets::Checkbox::deselect {index} {
  307.     set tag [gettag $index]
  308.     $itk_component($tag) deselect
  309. }
  310.  
  311. # ------------------------------------------------------------------
  312. # METHOD: flash index
  313. #
  314. # Flash the specified checkbutton.
  315. # ------------------------------------------------------------------
  316. itcl::body iwidgets::Checkbox::flash {index} {
  317.     set tag [gettag $index]
  318.     $itk_component($tag) flash  
  319. }
  320.  
  321. # ------------------------------------------------------------------
  322. # METHOD: buttonconfigure index ?option? ?value option value ...?
  323. #
  324. # Configure a specified checkbutton.  This method allows configuration 
  325. # of checkbuttons from the Checkbox level.  The options may have any 
  326. # of the values accepted by the add method.
  327. # ------------------------------------------------------------------
  328. itcl::body iwidgets::Checkbox::buttonconfigure {index args} { 
  329.     set tag [gettag $index]
  330.     eval $itk_component($tag) configure $args
  331. }
  332.  
  333. # ------------------------------------------------------------------
  334. # METHOD: gettag index
  335. #
  336. # Return the tag of the checkbutton associated with a specified
  337. # numeric index
  338. # ------------------------------------------------------------------
  339. itcl::body iwidgets::Checkbox::gettag {index} {
  340.     return [lindex $_buttons [index $index]]
  341. }
  342.