home *** CD-ROM | disk | FTP | other *** search
- #
- # 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}]
- }
- }
- }
- }
-
-
-