Subversion Repositories or1k

#

# 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.1.1.1 2002-01-16 10:24:50 markom 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

# ------------------------------------------------------------------

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 

    bind bbox-config  [code %W _positionButtons]

}

#

# Provide a lowercased access method for the Buttonbox class.

#

proc ::iwidgets::buttonbox {pathName args} {

    uplevel ::iwidgets::Buttonbox $pathName $args

}

# ------------------------------------------------------------------

#                        CONSTRUCTOR

# ------------------------------------------------------------------

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

# ------------------------------------------------------------------

body iwidgets::Buttonbox::destructor {} {

    if {$_resizeFlag != ""} {after cancel $_resizeFlag}

}

# ------------------------------------------------------------------

#                             OPTIONS

# ------------------------------------------------------------------

# ------------------------------------------------------------------

# OPTION: -pady

#

# Pad the y space between the button box frame and the hull.

# ------------------------------------------------------------------

configbody iwidgets::Buttonbox::pady {

    _setBoxSize

}

# ------------------------------------------------------------------

# OPTION: -padx

#

# Pad the x space between the button box frame and the hull.

# ------------------------------------------------------------------

configbody iwidgets::Buttonbox::padx {

    _setBoxSize

}

# ------------------------------------------------------------------

# OPTION: -orient

#

# Position buttons either horizontally or vertically.

# ------------------------------------------------------------------

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.

# ------------------------------------------------------------------

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.

# ------------------------------------------------------------------

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.

# ------------------------------------------------------------------

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.

# ------------------------------------------------------------------

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.

# ------------------------------------------------------------------

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.

# ------------------------------------------------------------------

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.

# ------------------------------------------------------------------

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.

# ------------------------------------------------------------------

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.

# ------------------------------------------------------------------

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.

# ------------------------------------------------------------------

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.

# -----------------------------------------------------------------

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.

# -----------------------------------------------------------------

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.

# ------------------------------------------------------------------

body iwidgets::Buttonbox::_setBoxSize {{when later}} {

    if {[winfo ismapped $itk_component(hull)]} {

        if {$when == "later"} {

            if {$_resizeFlag == ""} {

                set _resizeFlag [after idle [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.

# ------------------------------------------------------------------

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]

            }

        }

    }

}