diff options
Diffstat (limited to 'iwidgets/generic/buttonbox.itk')
| -rw-r--r-- | iwidgets/generic/buttonbox.itk | 571 |
1 files changed, 571 insertions, 0 deletions
diff --git a/iwidgets/generic/buttonbox.itk b/iwidgets/generic/buttonbox.itk new file mode 100644 index 00000000000..dabada368cc --- /dev/null +++ b/iwidgets/generic/buttonbox.itk @@ -0,0 +1,571 @@ +# +# Buttonbox +# ---------------------------------------------------------------------- +# Manages a framed area with Motif style buttons. The button box can +# be configured either horizontally or vertically. +# +# ---------------------------------------------------------------------- +# AUTHOR: Mark L. Ulferts EMAIL: mulferts@austin.dsccc.com +# Bret A. Schuhmacher EMAIL: bas@wn.com +# +# @(#) $Id$ +# ---------------------------------------------------------------------- +# Copyright (c) 1995 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. +# ====================================================================== + +# +# Usual options. +# +itk::usual Buttonbox { + keep -background -cursor -foreground +} + +# ------------------------------------------------------------------ +# BUTTONBOX +# ------------------------------------------------------------------ +itcl::class iwidgets::Buttonbox { + inherit itk::Widget + + constructor {args} {} + destructor {} + + itk_option define -pady padY Pad 5 + itk_option define -padx padX Pad 5 + itk_option define -orient orient Orient "horizontal" + itk_option define -foreground foreground Foreground black + + public method index {args} + public method add {args} + public method insert {args} + public method delete {args} + public method default {args} + public method hide {args} + public method show {args} + public method invoke {args} + public method buttonconfigure {args} + public method buttoncget {index option} + + private method _positionButtons {} + private method _setBoxSize {{when later}} + private method _getMaxWidth {} + private method _getMaxHeight {} + + private variable _resizeFlag {} ;# Flag for resize needed. + private variable _buttonList {} ;# List of all buttons in box. + private variable _displayList {} ;# List of displayed buttons. + private variable _unique 0 ;# Counter for button widget ids. +} + +namespace eval iwidgets::Buttonbox { + # + # Set up some class level bindings for map and configure events. + # + bind bbox-map <Map> [itcl::code %W _setBoxSize] + bind bbox-config <Configure> [itcl::code %W _positionButtons] +} + +# +# Provide a lowercased access method for the Buttonbox class. +# +proc ::iwidgets::buttonbox {pathName args} { + uplevel ::iwidgets::Buttonbox $pathName $args +} + +# ------------------------------------------------------------------ +# CONSTRUCTOR +# ------------------------------------------------------------------ +itcl::body iwidgets::Buttonbox::constructor {args} { + # + # Add Configure bindings for geometry management. + # + bindtags $itk_component(hull) \ + [linsert [bindtags $itk_component(hull)] 0 bbox-map] + bindtags $itk_component(hull) \ + [linsert [bindtags $itk_component(hull)] 1 bbox-config] + + pack propagate $itk_component(hull) no + + # + # Initialize the widget based on the command line options. + # + eval itk_initialize $args +} + +# ------------------------------------------------------------------ +# DESTRUCTOR +# ------------------------------------------------------------------ +itcl::body iwidgets::Buttonbox::destructor {} { + if {$_resizeFlag != ""} {after cancel $_resizeFlag} +} + +# ------------------------------------------------------------------ +# OPTIONS +# ------------------------------------------------------------------ + +# ------------------------------------------------------------------ +# OPTION: -pady +# +# Pad the y space between the button box frame and the hull. +# ------------------------------------------------------------------ +itcl::configbody iwidgets::Buttonbox::pady { + _setBoxSize +} + +# ------------------------------------------------------------------ +# OPTION: -padx +# +# Pad the x space between the button box frame and the hull. +# ------------------------------------------------------------------ +itcl::configbody iwidgets::Buttonbox::padx { + _setBoxSize +} + +# ------------------------------------------------------------------ +# OPTION: -orient +# +# Position buttons either horizontally or vertically. +# ------------------------------------------------------------------ +itcl::configbody iwidgets::Buttonbox::orient { + switch $itk_option(-orient) { + "horizontal" - + "vertical" { + _setBoxSize + } + + default { + error "bad orientation option \"$itk_option(-orient)\",\ + should be either horizontal or vertical" + } + } +} + +# ------------------------------------------------------------------ +# METHODS +# ------------------------------------------------------------------ + +# ------------------------------------------------------------------ +# METHOD: index index +# +# Searches the buttons in the box for the one with the requested tag, +# numerical index, keyword "end" or "default". Returns the button's +# tag if found, otherwise error. +# ------------------------------------------------------------------ +itcl::body iwidgets::Buttonbox::index {index} { + if {[llength $_buttonList] > 0} { + if {[regexp {(^[0-9]+$)} $index]} { + if {$index < [llength $_buttonList]} { + return $index + } else { + error "Buttonbox index \"$index\" is out of range" + } + + } elseif {$index == "end"} { + return [expr {[llength $_buttonList] - 1}] + + } elseif {$index == "default"} { + foreach knownButton $_buttonList { + if {[$itk_component($knownButton) cget -defaultring]} { + return [lsearch -exact $_buttonList $knownButton] + } + } + + error "Buttonbox \"$itk_component(hull)\" has no default" + + } else { + if {[set idx [lsearch $_buttonList $index]] != -1} { + return $idx + } + + error "bad Buttonbox index \"$index\": must be number, end,\ + default, or pattern" + } + + } else { + error "Buttonbox \"$itk_component(hull)\" has no buttons" + } +} + +# ------------------------------------------------------------------ +# METHOD: add tag ?option value option value ...? +# +# Add the specified button to the button box. All PushButton options +# are allowed. New buttons are added to the list of buttons and the +# list of displayed buttons. The PushButton path name is returned. +# ------------------------------------------------------------------ +itcl::body iwidgets::Buttonbox::add {tag args} { + itk_component add $tag { + iwidgets::Pushbutton $itk_component(hull).[incr _unique] + } { + usual + rename -highlightbackground -background background Background + } + + if {$args != ""} { + uplevel $itk_component($tag) configure $args + } + + lappend _buttonList $tag + lappend _displayList $tag + + _setBoxSize +} + +# ------------------------------------------------------------------ +# METHOD: insert index tag ?option value option value ...? +# +# Insert the specified button in the button box just before the one +# given by index. All PushButton options are allowed. New buttons +# are added to the list of buttons and the list of displayed buttons. +# The PushButton path name is returned. +# ------------------------------------------------------------------ +itcl::body iwidgets::Buttonbox::insert {index tag args} { + itk_component add $tag { + iwidgets::Pushbutton $itk_component(hull).[incr _unique] + } { + usual + rename -highlightbackground -background background Background + } + + if {$args != ""} { + uplevel $itk_component($tag) configure $args + } + + set index [index $index] + set _buttonList [linsert $_buttonList $index $tag] + set _displayList [linsert $_displayList $index $tag] + + _setBoxSize +} + +# ------------------------------------------------------------------ +# METHOD: delete index +# +# Delete the specified button from the button box. +# ------------------------------------------------------------------ +itcl::body iwidgets::Buttonbox::delete {index} { + set index [index $index] + set tag [lindex $_buttonList $index] + + destroy $itk_component($tag) + + set _buttonList [lreplace $_buttonList $index $index] + + if {[set dind [lsearch $_displayList $tag]] != -1} { + set _displayList [lreplace $_displayList $dind $dind] + } + + _setBoxSize + update idletasks +} + +# ------------------------------------------------------------------ +# METHOD: default index +# +# Sets the default to the push button given by index. +# ------------------------------------------------------------------ +itcl::body iwidgets::Buttonbox::default {index} { + set index [index $index] + + set defbtn [lindex $_buttonList $index] + + foreach knownButton $_displayList { + if {$knownButton == $defbtn} { + $itk_component($knownButton) configure -defaultring yes + } else { + $itk_component($knownButton) configure -defaultring no + } + } +} + +# ------------------------------------------------------------------ +# METHOD: hide index +# +# Hide the push button given by index. This doesn't remove the button +# permanently from the display list, just inhibits its display. +# ------------------------------------------------------------------ +itcl::body iwidgets::Buttonbox::hide {index} { + set index [index $index] + set tag [lindex $_buttonList $index] + + if {[set dind [lsearch $_displayList $tag]] != -1} { + place forget $itk_component($tag) + set _displayList [lreplace $_displayList $dind $dind] + + _setBoxSize + } +} + +# ------------------------------------------------------------------ +# METHOD: show index +# +# Displays a previously hidden push button given by index. Check if +# the button is already in the display list. If not then add it back +# at it's original location and redisplay. +# ------------------------------------------------------------------ +itcl::body iwidgets::Buttonbox::show {index} { + set index [index $index] + set tag [lindex $_buttonList $index] + + if {[lsearch $_displayList $tag] == -1} { + set _displayList [linsert $_displayList $index $tag] + + _setBoxSize + } +} + +# ------------------------------------------------------------------ +# METHOD: invoke ?index? +# +# Invoke the command associated with a push button. If no arguments +# are given then the default button is invoked, otherwise the argument +# is expected to be a button index. +# ------------------------------------------------------------------ +itcl::body iwidgets::Buttonbox::invoke {args} { + if {[llength $args] == 0} { + $itk_component([lindex $_buttonList [index default]]) invoke + + } else { + $itk_component([lindex $_buttonList [index [lindex $args 0]]]) \ + invoke + } +} + +# ------------------------------------------------------------------ +# METHOD: buttonconfigure index ?option? ?value option value ...? +# +# Configure a push button given by index. This method allows +# configuration of pushbuttons from the Buttonbox level. The options +# may have any of the values accepted by the add method. +# ------------------------------------------------------------------ +itcl::body iwidgets::Buttonbox::buttonconfigure {index args} { + set tag [lindex $_buttonList [index $index]] + + set retstr [uplevel $itk_component($tag) configure $args] + + _setBoxSize + + return $retstr +} + +# ------------------------------------------------------------------ +# METHOD: buttonccget index option +# +# Return value of option for push button given by index. Option may +# have any of the values accepted by the add method. +# ------------------------------------------------------------------ +itcl::body iwidgets::Buttonbox::buttoncget {index option} { + set tag [lindex $_buttonList [index $index]] + + set retstr [uplevel $itk_component($tag) cget [list $option]] + + return $retstr +} + +# ----------------------------------------------------------------- +# PRIVATE METHOD: _getMaxWidth +# +# Returns the required width of the largest button. +# ----------------------------------------------------------------- +itcl::body iwidgets::Buttonbox::_getMaxWidth {} { + set max 0 + + foreach tag $_displayList { + set w [winfo reqwidth $itk_component($tag)] + + if {$w > $max} { + set max $w + } + } + + return $max +} + +# ----------------------------------------------------------------- +# PRIVATE METHOD: _getMaxHeight +# +# Returns the required height of the largest button. +# ----------------------------------------------------------------- +itcl::body iwidgets::Buttonbox::_getMaxHeight {} { + set max 0 + + foreach tag $_displayList { + set h [winfo reqheight $itk_component($tag)] + + if {$h > $max} { + set max $h + } + } + + return $max +} + +# ------------------------------------------------------------------ +# METHOD: _setBoxSize ?when? +# +# Sets the proper size of the frame surrounding all the buttons. +# If "when" is "now", the change is applied immediately. If it is +# "later" or it is not specified, then the change is applied later, +# when the application is idle. +# ------------------------------------------------------------------ +itcl::body iwidgets::Buttonbox::_setBoxSize {{when later}} { + if {[winfo ismapped $itk_component(hull)]} { + if {$when == "later"} { + if {$_resizeFlag == ""} { + set _resizeFlag [after idle [itcl::code $this _setBoxSize now]] + } + return + } elseif {$when != "now"} { + error "bad option \"$when\": should be now or later" + } + + set _resizeFlag "" + + set numBtns [llength $_displayList] + + if {$itk_option(-orient) == "horizontal"} { + set minw [expr {$numBtns * [_getMaxWidth] \ + + ($numBtns+1) * $itk_option(-padx)}] + set minh [expr {[_getMaxHeight] + 2 * $itk_option(-pady)}] + + } else { + set minw [expr {[_getMaxWidth] + 2 * $itk_option(-padx)}] + set minh [expr {$numBtns * [_getMaxHeight] \ + + ($numBtns+1) * $itk_option(-pady)}] + } + + # + # Remove the configure event bindings on the hull while we adjust the + # width/height and re-position the buttons. Once we're through, we'll + # update and reinstall them. This prevents double calls to position + # the buttons. + # + set tags [bindtags $itk_component(hull)] + if {[set i [lsearch $tags bbox-config]] != -1} { + set tags [lreplace $tags $i $i] + bindtags $itk_component(hull) $tags + } + + component hull configure -width $minw -height $minh + + update idletasks + + _positionButtons + + bindtags $itk_component(hull) [linsert $tags 0 bbox-config] + } +} + +# ------------------------------------------------------------------ +# METHOD: _positionButtons +# +# This method is responsible setting the width/height of all the +# displayed buttons to the same value and for placing all the buttons +# in equidistant locations. +# ------------------------------------------------------------------ +itcl::body iwidgets::Buttonbox::_positionButtons {} { + set bf $itk_component(hull) + set numBtns [llength $_displayList] + + # + # First, determine the common width and height for all the + # displayed buttons. + # + if {$numBtns > 0} { + set bfWidth [winfo width $itk_component(hull)] + set bfHeight [winfo height $itk_component(hull)] + + if {$bfWidth >= [winfo reqwidth $itk_component(hull)]} { + set _btnWidth [_getMaxWidth] + + } else { + if {$itk_option(-orient) == "horizontal"} { + set _btnWidth [expr {$bfWidth / $numBtns}] + } else { + set _btnWidth $bfWidth + } + } + + if {$bfHeight >= [winfo reqheight $itk_component(hull)]} { + set _btnHeight [_getMaxHeight] + + } else { + if {$itk_option(-orient) == "vertical"} { + set _btnHeight [expr {$bfHeight / $numBtns}] + } else { + set _btnHeight $bfHeight + } + } + } + + # + # Place the buttons at the proper locations. + # + if {$numBtns > 0} { + if {$itk_option(-orient) == "horizontal"} { + set leftover [expr {[winfo width $bf] \ + - 2 * $itk_option(-padx) - $_btnWidth * $numBtns}] + + if {$numBtns > 0} { + set offset [expr {$leftover / ($numBtns + 1)}] + } else { + set offset 0 + } + if {$offset < 0} {set offset 0} + + set xDist [expr {$itk_option(-padx) + $offset}] + set incrAmount [expr {$_btnWidth + $offset}] + + foreach button $_displayList { + place $itk_component($button) -anchor w \ + -x $xDist -rely .5 -y 0 -relx 0 \ + -width $_btnWidth -height $_btnHeight + + set xDist [expr {$xDist + $incrAmount}] + } + + } else { + set leftover [expr {[winfo height $bf] \ + - 2 * $itk_option(-pady) - $_btnHeight * $numBtns}] + + if {$numBtns > 0} { + set offset [expr {$leftover / ($numBtns + 1)}] + } else { + set offset 0 + } + if {$offset < 0} {set offset 0} + + set yDist [expr {$itk_option(-pady) + $offset}] + set incrAmount [expr {$_btnHeight + $offset}] + + foreach button $_displayList { + place $itk_component($button) -anchor n \ + -y $yDist -relx .5 -x 0 -rely 0 \ + -width $_btnWidth -height $_btnHeight + + set yDist [expr {$yDist + $incrAmount}] + } + } + } +} + + |