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#
39itk::usual Radiobox {
40    keep -background -borderwidth -cursor -disabledforeground \
41	-foreground -labelfont -selectcolor
42}
43
44# ------------------------------------------------------------------
45#                            RADIOBOX
46# ------------------------------------------------------------------
47itcl::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#
88proc ::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#
95option add *Radiobox.labelMargin	10	widgetDefault
96option add *Radiobox.labelFont     \
97      "-Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*"  widgetDefault
98option add *Radiobox.labelPos		nw	widgetDefault
99option add *Radiobox.borderWidth	2	widgetDefault
100option add *Radiobox.relief		groove	widgetDefault
101
102# ------------------------------------------------------------------
103#                        CONSTRUCTOR
104# ------------------------------------------------------------------
105itcl::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# ------------------------------------------------------------------
124itcl::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# ------------------------------------------------------------------
140itcl::configbody iwidgets::Radiobox::command {}
141
142# ------------------------------------------------------------------
143# OPTION: -orient
144#
145# Allows the user to orient the radiobuttons either horizontally
146# or vertically.
147# ------------------------------------------------------------------
148itcl::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# ------------------------------------------------------------------
169itcl::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# ------------------------------------------------------------------
203itcl::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# ------------------------------------------------------------------
241itcl::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# ------------------------------------------------------------------
279itcl::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# ------------------------------------------------------------------
309itcl::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# ------------------------------------------------------------------
340itcl::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# ------------------------------------------------------------------
361itcl::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# ------------------------------------------------------------------
371itcl::body iwidgets::Radiobox::get {} {
372    return $_modes($this)
373}
374
375# ------------------------------------------------------------------
376# METHOD: deselect index
377#
378# Deselect the specified radiobutton.
379# ------------------------------------------------------------------
380itcl::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# ------------------------------------------------------------------
390itcl::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# ------------------------------------------------------------------
402itcl::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# ------------------------------------------------------------------
414itcl::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# ------------------------------------------------------------------
424itcl::body iwidgets::Radiobox::gettag {index} {
425    return [lindex $_buttons [index $index]]
426}
427
428