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 / radiobox.itk < prev    next >
Text File  |  2003-09-01  |  15KB  |  428 lines
  1. #
  2. # Radiobox
  3. # ----------------------------------------------------------------------
  4. # Implements a radiobuttonbox.  Supports adding, inserting, deleting,
  5. # selecting, and deselecting of radiobuttons by tag and index.
  6. #
  7. # ----------------------------------------------------------------------
  8. #  AUTHOR: Michael J. McLennan          EMAIL: mmclennan@lucent.com
  9. #          Mark L. Ulferts              EMAIL: mulferts@austin.dsccc.com
  10. #
  11. #  @(#) $Id: radiobox.itk,v 1.8 2002/02/27 05:59:07 mgbacke Exp $
  12. # ----------------------------------------------------------------------
  13. #            Copyright (c) 1995 DSC Technologies Corporation
  14. # ======================================================================
  15. # Permission to use, copy, modify, distribute and license this software 
  16. # and its documentation for any purpose, and without fee or written 
  17. # agreement with DSC, is hereby granted, provided that the above copyright 
  18. # notice appears in all copies and that both the copyright notice and 
  19. # warranty disclaimer below appear in supporting documentation, and that 
  20. # the names of DSC Technologies Corporation or DSC Communications 
  21. # Corporation not be used in advertising or publicity pertaining to the 
  22. # software without specific, written prior permission.
  23. # 
  24. # DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING 
  25. # ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
  26. # INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
  27. # AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, 
  28. # SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL 
  29. # DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR 
  30. # ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, 
  31. # WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
  32. # ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS 
  33. # SOFTWARE.
  34. # ======================================================================
  35.  
  36. #
  37. # Usual options.
  38. #
  39. itk::usual Radiobox {
  40.     keep -background -borderwidth -cursor -disabledforeground \
  41.     -foreground -labelfont -selectcolor
  42. }
  43.  
  44. # ------------------------------------------------------------------
  45. #                            RADIOBOX
  46. # ------------------------------------------------------------------
  47. itcl::class iwidgets::Radiobox {
  48.     inherit iwidgets::Labeledframe
  49.  
  50.     constructor {args} {}
  51.     destructor  {}
  52.  
  53.     itk_option define -disabledforeground \
  54.     disabledForeground DisabledForeground {}
  55.     itk_option define -selectcolor selectColor Background {}
  56.     itk_option define -command command Command {}
  57.     itk_option define -orient orient Orient vertical
  58.  
  59.     public {
  60.       method add {tag args}
  61.       method buttonconfigure {index args}
  62.       method component {{name ""} args}
  63.       method delete {index}
  64.       method deselect {index}
  65.       method flash {index}
  66.       method get {}
  67.       method index {index}
  68.       method insert {index tag args}
  69.       method select {index}
  70.     }
  71.  
  72.     protected method _command { name1 name2 opt }
  73.  
  74.     private {
  75.       method gettag {index}      ;# Get the tag of the checkbutton associated
  76.                                  ;# with a numeric index
  77.  
  78.       method _rearrange {}       ;# List of radiobutton tags.
  79.       variable _buttons {}       ;# List of radiobutton tags.
  80.       common _modes              ;# Current selection.
  81.       variable _unique 0         ;# Unique id for choice creation.
  82.     }
  83. }
  84.  
  85. #
  86. # Provide a lowercased access method for the Radiobox class.
  87. #
  88. proc ::iwidgets::radiobox {pathName args} {
  89.     uplevel ::iwidgets::Radiobox $pathName $args
  90. }
  91.  
  92. #
  93. # Use option database to override default resources of base classes.
  94. #
  95. option add *Radiobox.labelMargin    10    widgetDefault
  96. option add *Radiobox.labelFont     \
  97.       "-Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*"  widgetDefault
  98. option add *Radiobox.labelPos        nw    widgetDefault
  99. option add *Radiobox.borderWidth    2    widgetDefault
  100. option add *Radiobox.relief        groove    widgetDefault
  101.  
  102. # ------------------------------------------------------------------
  103. #                        CONSTRUCTOR
  104. # ------------------------------------------------------------------
  105. itcl::body iwidgets::Radiobox::constructor {args} {
  106.    
  107.     #
  108.     # Initialize the _modes array element prior to setting the trace. This
  109.     # prevents the -command command (if defined) from being triggered when
  110.     # the first radiobutton is added via the add method.
  111.     #
  112.     set _modes($this) {}
  113.  
  114.     trace variable [itcl::scope _modes($this)] w [itcl::code $this _command]
  115.  
  116.     grid columnconfigure $itk_component(childsite) 0 -weight 1
  117.  
  118.     eval itk_initialize $args
  119. }
  120.  
  121. # ------------------------------------------------------------------
  122. #                        DESTRUCTOR
  123. # ------------------------------------------------------------------
  124. itcl::body iwidgets::Radiobox::destructor { } {
  125.  
  126.     trace vdelete [itcl::scope _modes($this)] w [itcl::code $this _command]
  127.     catch {unset _modes($this)}
  128.  
  129. }
  130.  
  131. # ------------------------------------------------------------------
  132. #                            OPTIONS
  133. # ------------------------------------------------------------------
  134.  
  135. # ------------------------------------------------------------------
  136. # OPTION: -command
  137. #
  138. # Specifies a command to be evaluated upon change in the radiobox
  139. # ------------------------------------------------------------------
  140. itcl::configbody iwidgets::Radiobox::command {}
  141.  
  142. # ------------------------------------------------------------------
  143. # OPTION: -orient
  144. #
  145. # Allows the user to orient the radiobuttons either horizontally
  146. # or vertically.
  147. # ------------------------------------------------------------------
  148. itcl::configbody iwidgets::Radiobox::orient {
  149.   if {$itk_option(-orient) == "horizontal" ||
  150.       $itk_option(-orient) == "vertical"} {
  151.     _rearrange
  152.   } else {
  153.     error "Bad orientation: $itk_option(-orient).  Should be\
  154.       \"horizontal\" or \"vertical\"."
  155.   }
  156. }
  157.  
  158. # ------------------------------------------------------------------
  159. #                            METHODS
  160. # ------------------------------------------------------------------
  161.  
  162. # ------------------------------------------------------------------
  163. # METHOD: index index
  164. #
  165. # Searches the radiobutton tags in the radiobox for the one with the
  166. # requested tag, numerical index, or keyword "end".  Returns the 
  167. # choices's numerical index if found, otherwise error.
  168. # ------------------------------------------------------------------
  169. itcl::body iwidgets::Radiobox::index {index} {
  170.     if {[llength $_buttons] > 0} {
  171.         if {[regexp {(^[0-9]+$)} $index]} {
  172.             if {$index < [llength $_buttons]} {
  173.                 return $index
  174.             } else {
  175.                 error "Radiobox index \"$index\" is out of range"
  176.             }
  177.  
  178.         } elseif {$index == "end"} {
  179.             return [expr {[llength $_buttons] - 1}]
  180.  
  181.         } else {
  182.             if {[set idx [lsearch $_buttons $index]] != -1} {
  183.                 return $idx
  184.             }
  185.  
  186.             error "bad Radiobox index \"$index\": must be number, end,\
  187.                     or pattern"
  188.         }
  189.  
  190.     } else {
  191.         error "Radiobox \"$itk_component(hull)\" has no radiobuttons"
  192.     }
  193. }
  194.  
  195. # ------------------------------------------------------------------
  196. # METHOD: add tag ?option value option value ...?
  197. #
  198. # Add a new tagged radiobutton to the radiobox at the end.  The method 
  199. # takes additional options which are passed on to the radiobutton
  200. # constructor.  These include most of the typical radiobutton 
  201. # options.  The tag is returned.
  202. # ------------------------------------------------------------------
  203. itcl::body iwidgets::Radiobox::add {tag args} {
  204.     set options {-value -variable}
  205.     foreach option $options {
  206.       if {[lsearch $args $option] != -1} {
  207.     error "Error: specifying values for radiobutton component options\
  208.       \"-value\" and\n  \"-variable\" is disallowed.  The Radiobox must\
  209.       use these options when\n  adding radiobuttons."
  210.       }
  211.     }
  212.  
  213.     itk_component add $tag {
  214.         eval radiobutton $itk_component(childsite).rb[incr _unique] \
  215.             -variable [list [itcl::scope _modes($this)]] \
  216.             -anchor w \
  217.             -justify left \
  218.             -highlightthickness 0 \
  219.             -value $tag $args
  220.     } { 
  221.       usual
  222.       keep -state
  223.       ignore -highlightthickness -highlightcolor
  224.       rename -font -labelfont labelFont Font
  225.     }
  226.     lappend _buttons $tag
  227.     grid $itk_component($tag)
  228.     after idle [itcl::code $this _rearrange]
  229.  
  230.     return $tag
  231. }
  232.  
  233. # ------------------------------------------------------------------
  234. # METHOD: insert index tag ?option value option value ...?
  235. #
  236. # Insert the tagged radiobutton in the radiobox just before the 
  237. # one given by index.  Any additional options are passed on to the
  238. # radiobutton constructor.  These include the typical radiobutton
  239. # options.  The tag is returned.
  240. # ------------------------------------------------------------------
  241. itcl::body iwidgets::Radiobox::insert {index tag args} {
  242.     set options {-value -variable}
  243.     foreach option $options {
  244.       if {[lsearch $args $option] != -1} {
  245.     error "Error: specifying values for radiobutton component options\
  246.       \"-value\" and\n  \"-variable\" is disallowed.  The Radiobox must\
  247.       use these options when\n  adding radiobuttons."
  248.       }
  249.     }
  250.  
  251.     itk_component add $tag {
  252.         eval radiobutton $itk_component(childsite).rb[incr _unique] \
  253.             -variable [list [itcl::scope _modes($this)]] \
  254.             -highlightthickness 0 \
  255.             -anchor w \
  256.             -justify left \
  257.             -value $tag $args
  258.     } { 
  259.       usual
  260.       ignore -highlightthickness -highlightcolor
  261.       rename -font -labelfont labelFont Font
  262.     }
  263.     set index [index $index]
  264.     set before [lindex $_buttons $index]
  265.     set _buttons [linsert $_buttons $index $tag]
  266.     grid $itk_component($tag)
  267.     after idle [itcl::code $this _rearrange]
  268.  
  269.     return $tag
  270. }
  271.  
  272. # ------------------------------------------------------------------
  273. # METHOD: _rearrange
  274. #
  275. # Rearrange the buttons in the childsite frame using the grid
  276. # geometry manager.  This method was modified by Chad Smith on 3/9/00
  277. # to take into consideration the newly added -orient config option.
  278. # ------------------------------------------------------------------
  279. itcl::body iwidgets::Radiobox::_rearrange {} {
  280.     if {[set count [llength $_buttons]] > 0} {
  281.     if {$itk_option(-orient) == "vertical"} {
  282.             set row 0
  283.         foreach tag $_buttons {
  284.             grid configure $itk_component($tag) -column 0 -row $row -sticky nw
  285.             grid rowconfigure $itk_component(childsite) $row -weight 0
  286.             incr row
  287.         }
  288.         grid rowconfigure $itk_component(childsite) [expr {$count-1}] \
  289.           -weight 1
  290.     } else {
  291.             set col 0
  292.         foreach tag $_buttons {
  293.         grid configure $itk_component($tag) -column $col -row 0 -sticky nw
  294.             grid columnconfigure $itk_component(childsite) $col -weight 1
  295.         incr col
  296.         }
  297.     }
  298.     }
  299. }
  300.  
  301. # ------------------------------------------------------------------
  302. # METHOD: component ?name? ?arg arg arg...?
  303. #
  304. # This method overrides the base class definition to provide some
  305. # error checking. The user is disallowed from modifying the values
  306. # of the -value and -variable options for individual radiobuttons.
  307. # Addition of this method prompted by SF ticket 227923.
  308. # ------------------------------------------------------------------
  309. itcl::body iwidgets::Radiobox::component {{name ""} args} {
  310.   if {[lsearch $_buttons $name] != -1} {
  311.     # See if the user's trying to use the configure method. Note that
  312.     # because of globbing, as few characters as "co" are expanded to
  313.     # "config".  Similarly, "configu" will expand to "configure".
  314.     if [regexp {^co+} [lindex $args 0]] {
  315.       # The user's trying to modify a radiobutton.  This is all fine and
  316.       # dandy unless -value or -variable is being modified.
  317.       set options {-value -variable}
  318.       foreach option $options {
  319.     set index [lsearch $args $option]
  320.         if {$index != -1} {
  321.           # If a value is actually specified, throw an error.
  322.           if {[lindex $args [expr {$index + 1}]] != ""} {
  323.             error "Error: specifying values for radiobutton component options\
  324.               \"-value\" and\n  \"-variable\" is disallowed.  The Radiobox\
  325.               uses these options internally."
  326.           }
  327.         }
  328.       }
  329.     }
  330.   }
  331.  
  332.   eval chain $name $args
  333. }
  334.  
  335. # ------------------------------------------------------------------
  336. # METHOD: delete index
  337. #
  338. # Delete the specified radiobutton.
  339. # ------------------------------------------------------------------
  340. itcl::body iwidgets::Radiobox::delete {index} {
  341.  
  342.     set tag [gettag $index]
  343.     set index [index $index]
  344.  
  345.     destroy $itk_component($tag)
  346.  
  347.     set _buttons [lreplace $_buttons $index $index]
  348.  
  349.     if {$_modes($this) == $tag} {
  350.         set _modes($this) {}
  351.     }
  352.     after idle [itcl::code $this _rearrange]
  353.     return
  354. }
  355.  
  356. # ------------------------------------------------------------------
  357. # METHOD: select index
  358. #
  359. # Select the specified radiobutton.
  360. # ------------------------------------------------------------------
  361. itcl::body iwidgets::Radiobox::select {index} {
  362.     set tag [gettag $index]
  363.     $itk_component($tag) invoke
  364. }
  365.  
  366. # ------------------------------------------------------------------
  367. # METHOD: get
  368. #
  369. # Return the tag of the currently selected radiobutton.
  370. # ------------------------------------------------------------------
  371. itcl::body iwidgets::Radiobox::get {} {
  372.     return $_modes($this)
  373. }
  374.  
  375. # ------------------------------------------------------------------
  376. # METHOD: deselect index
  377. #
  378. # Deselect the specified radiobutton.
  379. # ------------------------------------------------------------------
  380. itcl::body iwidgets::Radiobox::deselect {index} {
  381.     set tag [gettag $index]
  382.     $itk_component($tag) deselect
  383. }
  384.  
  385. # ------------------------------------------------------------------
  386. # METHOD: flash index
  387. #
  388. # Flash the specified radiobutton.
  389. # ------------------------------------------------------------------
  390. itcl::body iwidgets::Radiobox::flash {index} {
  391.     set tag [gettag $index]
  392.     $itk_component($tag) flash  
  393. }
  394.  
  395. # ------------------------------------------------------------------
  396. # METHOD: buttonconfigure index ?option? ?value option value ...?
  397. #
  398. # Configure a specified radiobutton.  This method allows configuration 
  399. # of radiobuttons from the Radiobox level.  The options may have any 
  400. # of the values accepted by the add method.
  401. # ------------------------------------------------------------------
  402. itcl::body iwidgets::Radiobox::buttonconfigure {index args} { 
  403.     set tag [gettag $index]
  404.     eval $itk_component($tag) configure $args
  405. }
  406.  
  407. # ------------------------------------------------------------------
  408. # CALLBACK METHOD: _command name1 name2 opt 
  409. #
  410. # Tied to the trace on _modes($this). Whenever our -variable for our
  411. # radiobuttons change, this method is invoked. It in turn calls
  412. # the user specified tcl script given by -command.
  413. # ------------------------------------------------------------------
  414. itcl::body iwidgets::Radiobox::_command { name1 name2 opt } {
  415.     uplevel #0 $itk_option(-command)
  416. }
  417.  
  418. # ------------------------------------------------------------------
  419. # METHOD: gettag index
  420. #
  421. # Return the tag of the checkbutton associated with a specified
  422. # numeric index
  423. # ------------------------------------------------------------------
  424. itcl::body iwidgets::Radiobox::gettag {index} {
  425.     return [lindex $_buttons [index $index]]
  426. }
  427.  
  428.