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# 38option add *Checkbox.labelMargin 10 widgetDefault 39option add *Checkbox.labelFont \ 40 "-Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*" widgetDefault 41option add *Checkbox.labelPos nw widgetDefault 42option add *Checkbox.borderWidth 2 widgetDefault 43option add *Checkbox.relief groove widgetDefault 44 45# 46# Usual options. 47# 48itk::usual Checkbox { 49 keep -background -borderwidth -cursor -foreground -labelfont 50} 51 52# ------------------------------------------------------------------ 53# CHECKBOX 54# ------------------------------------------------------------------ 55itcl::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# 89proc ::iwidgets::checkbox {pathName args} { 90 uplevel ::iwidgets::Checkbox $pathName $args 91} 92 93# ------------------------------------------------------------------ 94# CONSTRUCTOR 95# ------------------------------------------------------------------ 96itcl::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# ------------------------------------------------------------------ 111itcl::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# ------------------------------------------------------------------ 138itcl::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# ------------------------------------------------------------------ 172itcl::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# ------------------------------------------------------------------ 207itcl::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# ------------------------------------------------------------------ 235itcl::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# ------------------------------------------------------------------ 252itcl::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# ------------------------------------------------------------------ 273itcl::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# ------------------------------------------------------------------ 284itcl::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# ------------------------------------------------------------------ 306itcl::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# ------------------------------------------------------------------ 316itcl::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# ------------------------------------------------------------------ 328itcl::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# ------------------------------------------------------------------ 339itcl::body iwidgets::Checkbox::gettag {index} { 340 return [lindex $_buttons [index $index]] 341} 342