diff options
Diffstat (limited to 'iwidgets/incoming/src/buttoncage.itk')
| -rw-r--r-- | iwidgets/incoming/src/buttoncage.itk | 585 |
1 files changed, 585 insertions, 0 deletions
diff --git a/iwidgets/incoming/src/buttoncage.itk b/iwidgets/incoming/src/buttoncage.itk new file mode 100644 index 00000000000..734899f44ef --- /dev/null +++ b/iwidgets/incoming/src/buttoncage.itk @@ -0,0 +1,585 @@ +# +# Buttoncage +# ---------------------------------------------------------------------- +# Manages a framed area with Motif style buttons. +# +# +# AUTHOR: Mark Alston EMAIL: mark@beernut.com +# +# ---------------------------------------------------------------------- +# Almost entirely Based on Button Box written by: +# 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 Buttoncage { + keep -background -cursor -foreground +} + +# ------------------------------------------------------------------ +# BUTTONCAGE +# ------------------------------------------------------------------ +itcl::class iwidgets::Buttoncage { + inherit itk::Widget + + constructor {args} {} + destructor {} + + itk_option define -pady padY Pad 5 + itk_option define -padx padX Pad 5 + itk_option define -width width Width 1 + itk_option define -height height Height 1 + 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 method _getNumButtons {} + + 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::Buttoncage { + # + # Set up some class level bindings for map and configure events. + # + bind bcage-map <Map> [itcl::code %W _setBoxSize] + bind bcage-config <Configure> [itcl::code %W _positionButtons] +} + +# +# Provide a lowercased access method for the Buttoncage class. +# +proc ::iwidgets::buttoncage {pathName args} { + uplevel ::iwidgets::Buttoncage $pathName $args +} + +# ------------------------------------------------------------------ +# CONSTRUCTOR +# ------------------------------------------------------------------ +itcl::body iwidgets::Buttoncage::constructor {args} { + # + # Add Configure bindings for geometry management. + # + bindtags $itk_component(hull) \ + [linsert [bindtags $itk_component(hull)] 0 bcage-map] + bindtags $itk_component(hull) \ + [linsert [bindtags $itk_component(hull)] 1 bcage-config] + + pack propagate $itk_component(hull) no + + # + # Initialize the widget based on the command line options. + # + eval itk_initialize $args +} + +# ------------------------------------------------------------------ +# DESTRUCTOR +# ------------------------------------------------------------------ +itcl::body iwidgets::Buttoncage::destructor {} { + if {$_resizeFlag != ""} {after cancel $_resizeFlag} +} + +# ------------------------------------------------------------------ +# OPTIONS +# ------------------------------------------------------------------ + +# ------------------------------------------------------------------ +# OPTION: -pady +# +# Pad the y space between the button box frame and the hull. +# ------------------------------------------------------------------ +itcl::configbody iwidgets::Buttoncage::pady { + _setBoxSize +} + +# ------------------------------------------------------------------ +# OPTION: -padx +# +# Pad the x space between the button box frame and the hull. +# ------------------------------------------------------------------ +itcl::configbody iwidgets::Buttoncage::padx { + _setBoxSize +} + +# ------------------------------------------------------------------ +# OPTION: -height +# +# Set buttonbox height in buttons +# ------------------------------------------------------------------ +itcl::configbody iwidgets::Buttoncage::height { + if { [regexp {^[0-9]*$} $itk_option(-height)] } { + _setBoxSize + } else { + error "bad height option \"$itk_option(-height)\",\ + should be an integer." + } +} + +# ------------------------------------------------------------------ +# OPTION: -width +# +# Set buttonbox width in buttons +# ------------------------------------------------------------------ +itcl::configbody iwidgets::Buttoncage::width { + if { [regexp {^[0-9]*$} $itk_option(-width)] } { + _setBoxSize + } else { + error "bad width option \"$itk_option(-width)\",\ + should be an integer." + } +} + +# ------------------------------------------------------------------ +# 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::Buttoncage::index {index} { + if {[llength $_buttonList] > 0} { + if {[regexp {(^[0-9]+$)} $index]} { + if {$index < [llength $_buttonList]} { + return $index + } else { + error "Buttoncage 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 "Buttoncage \"$itk_component(hull)\" has no default" + + } else { + if {[set idx [lsearch $_buttonList $index]] != -1} { + return $idx + } + + error "bad Buttoncage index \"$index\": must be number, end,\ + default, or pattern" + } + + } else { + error "Buttoncage \"$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::Buttoncage::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 + } + + if { [llength $_buttonList] < [_getNumButtons] } { + lappend _buttonList $tag + lappend _displayList $tag + + _setBoxSize + } else { + error "can't insert more buttons. \ + Buttoncage \"$itk_component(hull)\" is full." + } +} + +# ------------------------------------------------------------------ +# 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::Buttoncage::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 + } + + if { [llength $_buttonList] < [_getNumButtons] } { + set index [index $index] + set _buttonList [linsert $_buttonList $index $tag] + set _displayList [linsert $_displayList $index $tag] + + _setBoxSize + } else { + error "can't insert more buttons. \ + Buttoncage \"$itk_component(hull)\" is full." + } + +} + +# ------------------------------------------------------------------ +# METHOD: delete index +# +# Delete the specified button from the button box. +# ------------------------------------------------------------------ +itcl::body iwidgets::Buttoncage::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::Buttoncage::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::Buttoncage::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::Buttoncage::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::Buttoncage::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 Buttoncage level. The options +# may have any of the values accepted by the add method. +# ------------------------------------------------------------------ +itcl::body iwidgets::Buttoncage::buttonconfigure {index args} { + set tag [lindex $_buttonList [index $index]] + + set retstr [uplevel $itk_component($tag) configure $args] + + _setBoxSize + + return $retstr +} + +# ------------------------------------------------------------------ +# METHOD: buttoncget 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::Buttoncage::buttoncget {index option} { + set tag [lindex $_buttonList [index $index]] + + set retstr [uplevel $itk_component($tag) cget [list $option]] + + return $retstr +} + +# ----------------------------------------------------------------- +# PRIVATE METHOD: _getNumButtons +# +# Returns the max number of buttons. +# ----------------------------------------------------------------- +itcl::body iwidgets::Buttoncage::_getNumButtons {} { + set max [expr $itk_option(-width) * $itk_option(-height)] + return $max +} + +# ----------------------------------------------------------------- +# PRIVATE METHOD: _getMaxWidth +# +# Returns the required width of the largest button. +# ----------------------------------------------------------------- +itcl::body iwidgets::Buttoncage::_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::Buttoncage::_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::Buttoncage::_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 minw [expr { $itk_option(-width) * [_getMaxWidth] \ + + ($itk_option(-width) ) * $itk_option(-padx)}] + set minh [expr {$itk_option(-height) * [_getMaxHeight] \ + + ($itk_option(-height)) * $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 bcage-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 bcage-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::Buttoncage::_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 { + set _btnWidth [expr {$bfWidth / $itk_option(-width)}] + } + + + if {$bfHeight >= [winfo reqheight $itk_component(hull)]} { + set _btnHeight [_getMaxHeight] + + } else { + set _btnHeight [expr {$bfHeight / $itk_option(-height)}] + } + } + + # + # Place the buttons at the proper locations. + # + if {$numBtns > 0} { + set leftover_width [expr {[winfo width $bf] \ + - 2 * $itk_option(-padx) - $_btnWidth * $itk_option(-width)}] + set offset_width [expr {$leftover_width / ($itk_option(-width) + 1)}] + if {$offset_width < 0} {set offset_width 0} + + set xDist [expr {$itk_option(-padx) + $offset_width}] + set startxDist $xDist + + set incrAmountX [expr {$_btnWidth + $offset_width}] + + + set leftover_height [expr {[winfo height $bf] \ + - 2 * $itk_option(-pady) - $_btnHeight * $itk_option(-height)}] + set offset_height [expr {$leftover_height / ($itk_option(-height) + 1)}] + if {$offset_height < 0} {set offset_height 0} + + + + set yDist [expr {$itk_option(-pady) + $offset_height} + .5 * $_btnHeight] + set incrAmountY [expr {$_btnHeight + $offset_height}] + + set i 1 + foreach button $_displayList { + place $itk_component($button) -anchor w \ + -x $xDist -rely 0 -y $yDist -relx 0 \ + -width $_btnWidth -height $_btnHeight + if { $i == $itk_option(-width) } { + set yDist [expr {$yDist + $incrAmountY}] + set xDist $startxDist + set i 1 + } else { + set xDist [expr {$xDist + $incrAmountX}] + incr i + } + } + } +} + + |