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