home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 December / PCWorld_2000-12_cd.bin / Komunikace / Comanche / comanche.exe / lib / iwidgets2.2.0 / scripts / radiobox.itk < prev    next >
Text File  |  1999-02-24  |  10KB  |  294 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: michael.mclennan@att.com
  9. #          Mark L. Ulferts               EMAIL: mulferts@spd.dsccc.com
  10. #
  11. #  @(#) $Id: radiobox.itk,v 1.1 1998/07/27 18:49:47 stanton 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. # Default resources.
  38. #
  39. option add *Radiobox.borderWidth 2 widgetDefault
  40. option add *Radiobox.relief groove widgetDefault
  41. option add *Radiobox.labelPos n widgetDefault
  42.  
  43. #
  44. # Usual options.
  45. #
  46. itk::usual Radiobox {
  47.     keep -background -borderwidth -cursor -foreground -labelfont
  48. }
  49.  
  50. # ------------------------------------------------------------------
  51. #                            RADIOBOX
  52. # ------------------------------------------------------------------
  53. class iwidgets::Radiobox {
  54.     inherit iwidgets::Labeledwidget
  55.  
  56.     constructor {args} {}
  57.  
  58.     itk_option define -command command Command {}
  59.  
  60.     method index {index}
  61.     method add {tag args}
  62.     method insert {index tag args}
  63.     method delete {index}
  64.     method select {index}
  65.     method deselect {index}
  66.     method get {}
  67.     method flash {index}
  68.     method buttonconfigure {index args}
  69.  
  70.     method _command { name1 name2 opt }
  71.  
  72.     private variable _unique 0         ;# Unique id for choice creation.
  73.     private variable _buttons {}       ;# List of radiobutton tags.
  74.     private common _modes              ;# Current selection.
  75. }
  76.  
  77. #
  78. # Provide a lowercased access method for the Radiobox class.
  79. #
  80. proc ::iwidgets::radiobox {pathName args} {
  81.     uplevel ::iwidgets::Radiobox $pathName $args
  82. }
  83.  
  84. # ------------------------------------------------------------------
  85. #                        CONSTRUCTOR
  86. # ------------------------------------------------------------------
  87. body iwidgets::Radiobox::constructor {args} {
  88.     component hull configure -borderwidth 0
  89.  
  90.     itk_component add border {
  91.         frame $itk_interior.border
  92.     } {
  93.          keep -background -cursor -borderwidth -relief
  94.     }
  95.     pack $itk_component(border) -expand yes -fill both
  96.  
  97.     trace variable [scope _modes($this)] w [code $this _command]
  98.  
  99.     eval itk_initialize $args
  100. }
  101.  
  102. # ------------------------------------------------------------------
  103. #                            OPTIONS
  104. # ------------------------------------------------------------------
  105.  
  106. # ------------------------------------------------------------------
  107. # OPTION: -command
  108. #
  109. # Specifies a command to be evaluated upon change in the radiobox
  110. # ------------------------------------------------------------------
  111. configbody iwidgets::Radiobox::command {}
  112.  
  113. # ------------------------------------------------------------------
  114. #                            METHODS
  115. # ------------------------------------------------------------------
  116.  
  117. # ------------------------------------------------------------------
  118. # METHOD: index index
  119. #
  120. # Searches the radiobutton tags in the radiobox for the one with the
  121. # requested tag, numerical index, or keyword "end".  Returns the 
  122. # choices's numerical index if found, otherwise error.
  123. # ------------------------------------------------------------------
  124. body iwidgets::Radiobox::index {index} {
  125.     if {[llength $_buttons] > 0} {
  126.         if {[regexp {(^[0-9]+$)} $index]} {
  127.             if {$index < [llength $_buttons]} {
  128.                 return $index
  129.             } else {
  130.                 error "Radiobox index \"$index\" is out of range"
  131.             }
  132.  
  133.         } elseif {$index == "end"} {
  134.             return [expr [llength $_buttons] - 1]
  135.  
  136.         } else {
  137.             if {[set idx [lsearch $_buttons $index]] != -1} {
  138.                 return $idx
  139.             }
  140.  
  141.             error "bad Radiobox index \"$index\": must be number, end,\
  142.                     or pattern"
  143.         }
  144.  
  145.     } else {
  146.         error "Radiobox \"$itk_component(hull)\" has no radiobuttons"
  147.     }
  148. }
  149.  
  150. # ------------------------------------------------------------------
  151. # METHOD: add tag ?option value option value ...?
  152. #
  153. # Add a new tagged radiobutton to the radiobox at the end.  The method 
  154. # takes additional options which are passed on to the radiobutton
  155. # constructor.  These include most of the typical radiobutton 
  156. # options.  The tag is returned.
  157. # ------------------------------------------------------------------
  158. body iwidgets::Radiobox::add {tag args} {
  159.     itk_component add $tag {
  160.         eval radiobutton $itk_component(border).rb[incr _unique] \
  161.             -variable [list [scope _modes($this)]] -value $tag $args
  162.     } {
  163.         keep -background -foreground -cursor -font -text \
  164.          -activebackground -activeforeground -selectcolor \
  165.          -indicatoron -selectimage -state -highlightcolor \
  166.          -highlightthickness 
  167.     rename -highlightbackground -background background Background
  168.     }
  169.     pack $itk_component($tag) -anchor w -padx 4
  170.  
  171.     lappend _buttons $tag
  172.  
  173.     return $tag
  174. }
  175.  
  176. # ------------------------------------------------------------------
  177. # METHOD: insert index tag ?option value option value ...?
  178. #
  179. # Insert the tagged radiobutton in the radiobox just before the 
  180. # one given by index.  Any additional options are passed on to the
  181. # radiobutton constructor.  These include the typical radiobutton
  182. # options.  The tag is returned.
  183. # ------------------------------------------------------------------
  184. body iwidgets::Radiobox::insert {index tag args} {
  185.     itk_component add $tag {
  186.         eval radiobutton $itk_component(border).rb[incr _unique] \
  187.             -variable [list [scope _modes($this)]] -value $tag $args
  188.     } {
  189.         keep -background -foreground -cursor -font -text \
  190.          -activebackground -activeforeground -selectcolor \
  191.          -indicatoron -selectimage -state -highlightcolor \
  192.          -highlightthickness 
  193.     rename -highlightbackground -background background Background
  194.     }
  195.  
  196.     set index [index $index]
  197.     set before [lindex $_buttons $index]
  198.     set _buttons [linsert $_buttons $index $tag]
  199.  
  200.     pack $itk_component($tag) -anchor w -padx 4 -before $itk_component($before)
  201.  
  202.     return $tag
  203. }
  204.  
  205. # ------------------------------------------------------------------
  206. # METHOD: delete index
  207. #
  208. # Delete the specified radiobutton.
  209. # ------------------------------------------------------------------
  210. body iwidgets::Radiobox::delete {index} {
  211.     set index [index $index]
  212.     set tag [lindex $_buttons $index]
  213.  
  214.     destroy $itk_component($tag)
  215.  
  216.     set _buttons [lreplace $_buttons $index $index]
  217.  
  218.     if {$_modes($this) == $tag} {
  219.         set _modes($this) {}
  220.     }
  221.  
  222.     return
  223. }
  224.  
  225. # ------------------------------------------------------------------
  226. # METHOD: select index
  227. #
  228. # Select the specified radiobutton.
  229. # ------------------------------------------------------------------
  230. body iwidgets::Radiobox::select {index} {
  231.     set index [index $index]
  232.     set tag [lindex $_buttons $index]
  233.  
  234.     $itk_component($tag) invoke
  235. }
  236.  
  237. # ------------------------------------------------------------------
  238. # METHOD: get
  239. #
  240. # Return the tag of the currently selected radiobutton.
  241. # ------------------------------------------------------------------
  242. body iwidgets::Radiobox::get {} {
  243.     return $_modes($this)
  244. }
  245.  
  246. # ------------------------------------------------------------------
  247. # METHOD: deselect index
  248. #
  249. # Deselect the specified radiobutton.
  250. # ------------------------------------------------------------------
  251. body iwidgets::Radiobox::deselect {index} {
  252.     set index [index $index]
  253.     set tag [lindex $_buttons $index]
  254.  
  255.     $itk_component($tag) deselect
  256. }
  257.  
  258. # ------------------------------------------------------------------
  259. # METHOD: flash index
  260. #
  261. # Flash the specified radiobutton.
  262. # ------------------------------------------------------------------
  263. body iwidgets::Radiobox::flash {index} {
  264.     set index [index $index]
  265.     set tag [lindex $_buttons $index]
  266.  
  267.     $itk_component($tag) flash  
  268. }
  269.  
  270. # ------------------------------------------------------------------
  271. # METHOD: buttonconfigure index ?option? ?value option value ...?
  272. #
  273. # Configure a specified radiobutton.  This method allows configuration 
  274. # of radiobuttons from the Radiobox level.  The options may have any 
  275. # of the values accepted by the add method.
  276. # ------------------------------------------------------------------
  277. body iwidgets::Radiobox::buttonconfigure {index args} { 
  278.     set index [index $index]
  279.     set tag [lindex $_buttons $index]
  280.  
  281.     eval $itk_component($tag) configure $args
  282. }
  283.  
  284. # ------------------------------------------------------------------
  285. # CALLBACK METHOD: _command name1 name2 opt 
  286. #
  287. # Tied to the trace on _modes($this). Whenever our -variable for our
  288. # radiobuttons change, this method is invoked. It in turn calls
  289. # the user specified tcl script given by -command.
  290. # ------------------------------------------------------------------
  291. body iwidgets::Radiobox::_command { name1 name2 opt } {
  292.     uplevel #0 $itk_option(-command)
  293. }
  294.