diff options
Diffstat (limited to 'iwidgets/generic/checkbox.itk')
| -rw-r--r-- | iwidgets/generic/checkbox.itk | 341 |
1 files changed, 341 insertions, 0 deletions
diff --git a/iwidgets/generic/checkbox.itk b/iwidgets/generic/checkbox.itk new file mode 100644 index 00000000000..49e88887f76 --- /dev/null +++ b/iwidgets/generic/checkbox.itk @@ -0,0 +1,341 @@ +# +# Checkbox +# ---------------------------------------------------------------------- +# Implements a checkbuttonbox. Supports adding, inserting, deleting, +# selecting, and deselecting of checkbuttons by tag and index. +# +# ---------------------------------------------------------------------- +# AUTHOR: John A. Tucker EMAIL: jatucker@spd.dsccc.com +# +# ---------------------------------------------------------------------- +# Copyright (c) 1997 DSC Technologies Corporation +# ====================================================================== +# Permission to use, copy, modify, distribute and license this software +# and its documentation for any purpose, and without fee or written +# agreement with DSC, is hereby granted, provided that the above copyright +# notice appears in all copies and that both the copyright notice and +# warranty disclaimer below appear in supporting documentation, and that +# the names of DSC Technologies Corporation or DSC Communications +# Corporation not be used in advertising or publicity pertaining to the +# software without specific, written prior permission. +# +# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING +# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- +# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE +# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, +# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL +# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR +# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, +# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, +# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS +# SOFTWARE. +# ====================================================================== + + +# +# Use option database to override default resources of base classes. +# +option add *Checkbox.labelMargin 10 widgetDefault +option add *Checkbox.labelFont \ + "-Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*" widgetDefault +option add *Checkbox.labelPos nw widgetDefault +option add *Checkbox.borderWidth 2 widgetDefault +option add *Checkbox.relief groove widgetDefault + +# +# Usual options. +# +itk::usual Checkbox { + keep -background -borderwidth -cursor -foreground -labelfont +} + +# ------------------------------------------------------------------ +# CHECKBOX +# ------------------------------------------------------------------ +itcl::class iwidgets::Checkbox { + inherit iwidgets::Labeledframe + + constructor {args} {} + + itk_option define -orient orient Orient vertical + + public { + method add {tag args} + method insert {index tag args} + method delete {index} + method get {{index ""}} + method index {index} + method select {index} + method deselect {index} + method flash {index} + method toggle {index} + method buttonconfigure {index args} + } + + private { + + method gettag {index} ;# Get the tag of the checkbutton associated + ;# with a numeric index + + variable _unique 0 ;# Unique id for choice creation. + variable _buttons {} ;# List of checkbutton tags. + common buttonVar ;# Array of checkbutton "-variables" + } +} + +# +# Provide a lowercased access method for the Checkbox class. +# +proc ::iwidgets::checkbox {pathName args} { + uplevel ::iwidgets::Checkbox $pathName $args +} + +# ------------------------------------------------------------------ +# CONSTRUCTOR +# ------------------------------------------------------------------ +itcl::body iwidgets::Checkbox::constructor {args} { + + eval itk_initialize $args +} + +# ------------------------------------------------------------------ +# OPTIONS +# ------------------------------------------------------------------ + +# ------------------------------------------------------------------ +# OPTION: -orient +# +# Allows the user to orient the checkbuttons either horizontally +# or vertically. Added by Chad Smith (csmith@adc.com) 3/10/00. +# ------------------------------------------------------------------ +itcl::configbody iwidgets::Checkbox::orient { + if {$itk_option(-orient) == "horizontal"} { + foreach tag $_buttons { + pack $itk_component($tag) -side left -anchor nw -padx 4 -expand 1 + } + } elseif {$itk_option(-orient) == "vertical"} { + foreach tag $_buttons { + pack $itk_component($tag) -side top -anchor w -padx 4 -expand 0 + } + } else { + error "Bad orientation: $itk_option(-orient). Should be\ + \"horizontal\" or \"vertical\"." + } +} + + +# ------------------------------------------------------------------ +# METHODS +# ------------------------------------------------------------------ + +# ------------------------------------------------------------------ +# METHOD: index index +# +# Searches the checkbutton tags in the checkbox for the one with the +# requested tag, numerical index, or keyword "end". Returns the +# choices's numerical index if found, otherwise error. +# ------------------------------------------------------------------ +itcl::body iwidgets::Checkbox::index {index} { + if {[llength $_buttons] > 0} { + if {[regexp {(^[0-9]+$)} $index]} { + if {$index < [llength $_buttons]} { + return $index + } else { + error "Checkbox index \"$index\" is out of range" + } + + } elseif {$index == "end"} { + return [expr {[llength $_buttons] - 1}] + + } else { + if {[set idx [lsearch $_buttons $index]] != -1} { + return $idx + } + + error "bad Checkbox index \"$index\": must be number, end,\ + or pattern" + } + + } else { + error "Checkbox \"$itk_component(hull)\" has no checkbuttons" + } +} + +# ------------------------------------------------------------------ +# METHOD: add tag ?option value option value ...? +# +# Add a new tagged checkbutton to the checkbox at the end. The method +# takes additional options which are passed on to the checkbutton +# constructor. These include most of the typical checkbutton +# options. The tag is returned. +# ------------------------------------------------------------------ +itcl::body iwidgets::Checkbox::add {tag args} { + itk_component add $tag { + eval checkbutton $itk_component(childsite).cb[incr _unique] \ + -variable [list [itcl::scope buttonVar($this,$tag)]] \ + -anchor w \ + -justify left \ + -highlightthickness 0 \ + $args + } { + usual + keep -command -disabledforeground -selectcolor -state + ignore -highlightthickness -highlightcolor + rename -font -labelfont labelFont Font + } + + # Redraw the buttons with the proper orientation. + if {$itk_option(-orient) == "vertical"} { + pack $itk_component($tag) -side top -anchor w -padx 4 -expand 0 + } else { + pack $itk_component($tag) -side left -anchor nw -expand 1 + } + + lappend _buttons $tag + + return $tag +} + +# ------------------------------------------------------------------ +# METHOD: insert index tag ?option value option value ...? +# +# Insert the tagged checkbutton in the checkbox just before the +# one given by index. Any additional options are passed on to the +# checkbutton constructor. These include the typical checkbutton +# options. The tag is returned. +# ------------------------------------------------------------------ +itcl::body iwidgets::Checkbox::insert {index tag args} { + itk_component add $tag { + eval checkbutton $itk_component(childsite).cb[incr _unique] \ + -variable [list [itcl::scope buttonVar($this,$tag)]] \ + -anchor w \ + -justify left \ + -highlightthickness 0 \ + $args + } { + usual + ignore -highlightthickness -highlightcolor + rename -font -labelfont labelFont Font + } + + set index [index $index] + set before [lindex $_buttons $index] + set _buttons [linsert $_buttons $index $tag] + + pack $itk_component($tag) -anchor w -padx 4 -before $itk_component($before) + + return $tag +} + +# ------------------------------------------------------------------ +# METHOD: delete index +# +# Delete the specified checkbutton. +# ------------------------------------------------------------------ +itcl::body iwidgets::Checkbox::delete {index} { + + set tag [gettag $index] + set index [index $index] + destroy $itk_component($tag) + set _buttons [lreplace $_buttons $index $index] + + if { [info exists buttonVar($this,$tag)] == 1 } { + unset buttonVar($this,$tag) + } +} + +# ------------------------------------------------------------------ +# METHOD: select index +# +# Select the specified checkbutton. +# ------------------------------------------------------------------ +itcl::body iwidgets::Checkbox::select {index} { + set tag [gettag $index] + #----------------------------------------------------------- + # BUG FIX: csmith (Chad Smith: csmith@adc.com), 3/30/99 + #----------------------------------------------------------- + # This method should only invoke the checkbutton if it's not + # already selected. Check its associated variable, and if + # it's set, then just ignore and return. + #----------------------------------------------------------- + if {[set [itcl::scope buttonVar($this,$tag)]] == + [[component $tag] cget -onvalue]} { + return + } + $itk_component($tag) invoke +} + +# ------------------------------------------------------------------ +# METHOD: toggle index +# +# Toggle a specified checkbutton between selected and unselected +# ------------------------------------------------------------------ +itcl::body iwidgets::Checkbox::toggle {index} { + set tag [gettag $index] + $itk_component($tag) toggle +} + +# ------------------------------------------------------------------ +# METHOD: get +# +# Return the value of the checkbutton with the given index, or a +# list of all checkbutton values in increasing order by index. +# ------------------------------------------------------------------ +itcl::body iwidgets::Checkbox::get {{index ""}} { + set result {} + + if {$index == ""} { + foreach tag $_buttons { + if {$buttonVar($this,$tag)} { + lappend result $tag + } + } + } else { + set tag [gettag $index] + set result $buttonVar($this,$tag) + } + + return $result +} + +# ------------------------------------------------------------------ +# METHOD: deselect index +# +# Deselect the specified checkbutton. +# ------------------------------------------------------------------ +itcl::body iwidgets::Checkbox::deselect {index} { + set tag [gettag $index] + $itk_component($tag) deselect +} + +# ------------------------------------------------------------------ +# METHOD: flash index +# +# Flash the specified checkbutton. +# ------------------------------------------------------------------ +itcl::body iwidgets::Checkbox::flash {index} { + set tag [gettag $index] + $itk_component($tag) flash +} + +# ------------------------------------------------------------------ +# METHOD: buttonconfigure index ?option? ?value option value ...? +# +# Configure a specified checkbutton. This method allows configuration +# of checkbuttons from the Checkbox level. The options may have any +# of the values accepted by the add method. +# ------------------------------------------------------------------ +itcl::body iwidgets::Checkbox::buttonconfigure {index args} { + set tag [gettag $index] + eval $itk_component($tag) configure $args +} + +# ------------------------------------------------------------------ +# METHOD: gettag index +# +# Return the tag of the checkbutton associated with a specified +# numeric index +# ------------------------------------------------------------------ +itcl::body iwidgets::Checkbox::gettag {index} { + return [lindex $_buttons [index $index]] +} |