| # |
| # 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: buttonbox.itk,v 1.3 2001/08/15 18:30:53 smithc Exp $ |
| # ---------------------------------------------------------------------- |
| # 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}] |
| } |
| } |
| } |
| } |
| |
| |