Subversion Repositories or1k

#

# Toolbar

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

#

# The Toolbar command creates a new window (given by the pathName

# argument) and makes it into a Tool Bar widget. Additional options,

# described above may be specified on the command line or in the

# option database to configure aspects of the Toolbar such as its

# colors, font, and orientation. The Toolbar command returns its

# pathName argument. At the time this command is invoked, there

# must not exist a window named pathName, but pathName's parent

# must exist.

#

# A Toolbar is a widget that displays a collection of widgets arranged

# either in a row or a column (depending on the value of the -orient

# option). This collection of widgets is usually for user convenience

# to give access to a set of commands or settings. Any widget may be

# placed on a Toolbar. However, command or value-oriented widgets (such

# as button, radiobutton, etc.) are usually the most useful kind of

# widgets to appear on a Toolbar.

#

# WISH LIST:

#   This section lists possible future enhancements.

#

#       Toggle between text and image/bitmap so that the toolbar could

#     display either all text or all image/bitmaps.

#   Implementation of the -toolbarfile option that allows toolbar

#     add commands to be read in from a file.

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

#  AUTHOR: Bill W. Scott                 EMAIL: bscott@spd.dsccc.com

#

#  @(#) $Id: toolbar.itk,v 1.1.1.1 2002-01-16 10:24:51 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.

# ======================================================================

#

# Default resources.

#

option add *Toolbar*padX 5 widgetDefault

option add *Toolbar*padY 5 widgetDefault

option add *Toolbar*orient horizontal widgetDefault

option add *Toolbar*highlightThickness 0 widgetDefault

option add *Toolbar*indicatorOn false widgetDefault

option add *Toolbar*selectColor [. cget -bg] widgetDefault

#

# Usual options.

#

itk::usual Toolbar {

    keep -activebackground -activeforeground -background -balloonbackground \

         -balloondelay1 -balloondelay2 -balloonfont -balloonforeground \

         -borderwidth -cursor -disabledforeground -font -foreground \

         -highlightbackground -highlightcolor -highlightthickness \

         -insertbackground -insertforeground -selectbackground \

         -selectborderwidth -selectcolor -selectforeground -troughcolor

}

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

#                            TOOLBAR

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

class iwidgets::Toolbar {

    inherit itk::Widget

    constructor {args} {}

    destructor {}

    itk_option define -balloonbackground \

            balloonBackground BalloonBackground yellow

    itk_option define -balloonforeground \

            balloonForeground BalloonForeground black

    itk_option define -balloonfont balloonFont BalloonFont 6x10

    itk_option define -balloondelay1 \

            balloonDelay1 BalloonDelay1 1000

    itk_option define -balloondelay2 \

            balloonDelay2 BalloonDelay2 200

    itk_option define -helpvariable helpVariable HelpVariable {}

    itk_option define -orient orient Orient "horizontal"

    #

    # The following options implement propogated configurations to

    # any widget that might be added to us. The problem is this is

    # not deterministic as someone might add a new kind of widget with

    # and option like -armbackground, so we would not be aware of

    # this kind of option. Anyway we support as many of the obvious

    # ones that we can. They can always configure them with itemconfigures.

    #

    itk_option define -activebackground activeBackground Foreground #c3c3c3

    itk_option define -activeforeground activeForeground Background Black

    itk_option define -background background Background #d9d9d9

    itk_option define -borderwidth borderWidth BorderWidth 2

    itk_option define -cursor cursor Cursor {}

    itk_option define -disabledforeground \

            disabledForeground DisabledForeground #a3a3a3

    itk_option define -font \

            font Font "-Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*"

    itk_option define -foreground foreground Foreground #000000000000

    itk_option define -highlightbackground \

            highlightBackground HighlightBackground #d9d9d9

    itk_option define -highlightcolor highlightColor HighlightColor Black

    itk_option define -highlightthickness \

            highlightThickness HighlightThickness 0

    itk_option define -insertforeground insertForeground Background #c3c3c3

    itk_option define -insertbackground insertBackground Foreground Black

    itk_option define -selectbackground selectBackground Foreground #c3c3c3

    itk_option define -selectborderwidth selectBorderWidth BorderWidth {}

    itk_option define -selectcolor selectColor Background #b03060

    itk_option define -selectforeground selectForeground Background Black

    itk_option define -state state State normal

    itk_option define -troughcolor troughColor Background #c3c3c3

    public method add {widgetCommand name args}

    public method delete {args}

    public method index {index}

    public method insert {beforeIndex widgetCommand name args}

    public method itemcget {index args}

    public method itemconfigure {index args}

    public method _resetBalloonTimer {}

    public method _startBalloonDelay {window}

    public method _stopBalloonDelay {window balloonClick}

    private method _deleteWidgets {index1 index2}

    private method _addWidget {widgetCommand name args}

    private method _index {toolList index}

    private method _getAttachedOption {optionListName widget args retValue}

    private method _setAttachedOption {optionListName widget option args}

    private method _packToolbar {}

    public method hideHelp {}

    public method showHelp {window}

    public method showBalloon {window}

    public method hideBalloon {}

    private variable _balloonTimer 0

    private variable _balloonAfterID 0

    private variable _balloonClick false

    private variable _interior {}

    private variable _initialMapping 1   ;# Is this the first mapping?

    private variable _toolList {}        ;# List of all widgets on toolbar

    private variable _opts               ;# New options for child widgets

    private variable _currHelpWidget {}  ;# Widget currently displaying help for

    private variable _hintWindow {}      ;# Balloon help bubble.

    # list of options we want to propogate to widgets added to toolbar.

    private common _optionList {

        -activebackground \

                -activeforeground \

                -background \

                -borderwidth \

                -cursor \

                -disabledforeground \

                -font \

                -foreground \

                -highlightbackground \

                -highlightcolor \

                -highlightthickness \

                -insertbackground \

                -insertforeground \

                -selectbackground \

                -selectborderwidth \

                -selectcolor \

                -selectforeground \

                -state \

                -troughcolor \

            }

}

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

#                            CONSTRUCTOR

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

body iwidgets::Toolbar::constructor {args} {

    component hull configure -borderwidth 0

    set _interior $itk_interior

    #

    # Handle configs

    #

    eval itk_initialize $args

    # build balloon help window

    set _hintWindow [toplevel $itk_component(hull).balloonHintWindow]

    wm withdraw $_hintWindow

    label $_hintWindow.label \

        -foreground $itk_option(-balloonforeground) \

        -background $itk_option(-balloonbackground) \

        -font $itk_option(-balloonfont) \

        -relief raised \

        -borderwidth 1

    pack $_hintWindow.label

    # ... Attach help handler to this widget

    bind toolbar-help-$itk_component(hull) \

             "+[code $this showHelp %W]"

    bind toolbar-help-$itk_component(hull) \

             "+[code $this hideHelp]"

    # ... Set up Microsoft style balloon help display.

    set _balloonTimer $itk_option(-balloondelay1)

    bind $_interior \

             "+[code $this _resetBalloonTimer]"

    bind toolbar-balloon-$itk_component(hull) \

             "+[code $this _startBalloonDelay %W]"

    bind toolbar-balloon-$itk_component(hull) \

             "+[code $this _stopBalloonDelay %W false]"

    bind toolbar-balloon-$itk_component(hull) \

             "+[code $this _stopBalloonDelay %W true]"

}

#

# Provide a lowercase access method for the Toolbar class

#

proc ::iwidgets::toolbar {pathName args} {

    uplevel ::iwidgets::Toolbar $pathName $args

}

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

#                           DESTURCTOR

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

body iwidgets::Toolbar::destructor {} {

    if {$_balloonAfterID != 0} {after cancel $_balloonAfterID}

}

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

#                            OPTIONS

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

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

# OPTION -balloonbackground

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

configbody iwidgets::Toolbar::balloonbackground {

    if { $_hintWindow != {} } {

        if { $itk_option(-balloonbackground) != {} } {

            $_hintWindow.label configure \

                -background $itk_option(-balloonbackground)

        }

    }

}

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

# OPTION -balloonforeground

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

configbody iwidgets::Toolbar::balloonforeground {

    if { $_hintWindow != {} } {

        if { $itk_option(-balloonforeground) != {} } {

            $_hintWindow.label configure \

                -foreground $itk_option(-balloonforeground)

        }

    }

}

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

# OPTION -balloonfont

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

configbody iwidgets::Toolbar::balloonfont {

    if { $_hintWindow != {} } {

        if { $itk_option(-balloonfont) != {} } {

            $_hintWindow.label configure \

                -font $itk_option(-balloonfont)

        }

    }

}

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

# OPTION: -orient

#

# Position buttons either horizontally or vertically.

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

configbody iwidgets::Toolbar::orient {

    switch $itk_option(-orient) {

        "horizontal" - "vertical" {

            _packToolbar

        }

        default {error "Invalid orientation. Must be either \

                horizontal or vertical"

        }

    }

}

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

#                            METHODS

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

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

# METHOD: add widgetCommand name ?option value?

#

# Adds a widget with the command widgetCommand whose name is

# name to the Toolbar.   If widgetCommand is radiobutton

# or checkbutton, its packing is slightly padded to match the

# geometry of button widgets.

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

body iwidgets::Toolbar::add { widgetCommand name args } {

    eval "_addWidget $widgetCommand $name $args"

    lappend _toolList $itk_component($name)

    if { $widgetCommand == "radiobutton" || \

            $widgetCommand == "checkbutton" } {

        set iPad 1

    } else {

        set iPad 0

    }

    # repack the tool bar

    _packToolbar

    return $itk_component($name)

}

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

#

# METHOD: delete index ?index2?

#

# This command deletes all components between index and

# index2 inclusive. If index2 is omitted then it defaults

# to index. Returns an empty string

#

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

body iwidgets::Toolbar::delete { args } {

    # empty toolbar

    if { $_toolList == {} } {

        error "can't delete widget, no widgets in the Toolbar \

                \"$itk_component(hull)\""

    }

    set len [llength $args]

    switch -- $len {

        1 {

            set fromWidget [_index $_toolList [lindex $args 0]]

            if { $fromWidget < 0 || $fromWidget >= [llength $_toolList] } {

                error "bad Toolbar widget index in delete method: \

                        should be between 0 and [expr [llength $_toolList] - 1]"

            }

            set toWidget $fromWidget

            _deleteWidgets $fromWidget $toWidget

        }

        2 {

            set fromWidget [_index $_toolList [lindex $args 0]]

            if { $fromWidget < 0 || $fromWidget >= [llength $_toolList] } {

                error "bad Toolbar widget index1 in delete method: \

                        should be between 0 and [expr [llength $_toolList] - 1]"

            }

            set toWidget [_index $_toolList [lindex $args 1]]

            if { $toWidget < 0 || $toWidget >= [llength $_toolList] } {

                error "bad Toolbar widget index2 in delete method: \

                        should be between 0 and [expr [llength $_toolList] - 1]"

            }

            if { $fromWidget > $toWidget } {

                error "bad Toolbar widget index1 in delete method: \

                        index1 is greater than index2"

            }

            _deleteWidgets $fromWidget $toWidget

        }

        default {

            # ... too few/many parameters passed

            error "wrong # args: should be \

                    \"$itk_component(hull) delete index1 ?index2?\""

        }

    }

    return {}

}

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

#

# METHOD: index index

#

# Returns the widget's numerical index for the entry corresponding

# to index. If index is not found, -1 is returned

#

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

body iwidgets::Toolbar::index { index } {

    return [_index $_toolList $index]

}

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

#

# METHOD: insert beforeIndex widgetCommand name ?option value?

#

# Insert a new component named name with the command

# widgetCommand before the com ponent specified by beforeIndex.

# If widgetCommand is radiobutton or checkbutton, its packing

# is slightly padded to match the geometry of button widgets.

#

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

body iwidgets::Toolbar::insert {  beforeIndex widgetCommand name args } {

    set beforeIndex [_index $_toolList $beforeIndex]

    if {$beforeIndex < 0 || $beforeIndex > [llength $_toolList] } {

        error "bad toolbar entry index $beforeIndex"

    }

    eval "_addWidget $widgetCommand $name $args"

    # linsert into list

    set _toolList [linsert $_toolList $beforeIndex $itk_component($name)]

    # repack the tool bar

    _packToolbar

    return $itk_component($name)

}

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

# METHOD: itemcget index ?option?

#

# Returns the value for the option setting of the widget at index $index.

# index can be numeric or widget name

#

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

body iwidgets::Toolbar::itemcget { index args} {

    return [lindex [eval itemconfigure $index $args] 4]

}

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

#

# METHOD: itemconfigure index ?option? ?value? ?option value...?

#

# Query or modify the configuration options of the widget of

# the Toolbar specified by index. If no option is specified,

# returns a list describing all of the available options for

# index (see Tk_ConfigureInfo for information on the format

# of this list). If option is specified with no value, then

# the command returns a list describing the one named option

# (this list will be identical to the corresponding sublist

# of the value returned if no option is specified). If one

# or more option-value pairs are specified, then the command

# modifies the given widget option(s) to have the given

# value(s); in this case the command returns an empty string.

# The component type of index determines the valid available options.

#

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

body iwidgets::Toolbar::itemconfigure { index args } {

    # Get a numeric index.

    set index [_index $_toolList $index]

    # Get the tool path

    set toolPath [lindex $_toolList $index]

    set len [llength $args]

    switch $len {

            # show all options

            # ''''''''''''''''

            # support display of -helpstr and -balloonstr configs

            set optList [$toolPath configure]

            ## @@@ might want to use _getAttachedOption instead...

            if { [info exists _opts($toolPath,-helpstr)] } {

                set value $_opts($toolPath,-helpstr)

            } else {

                set value {}

            }

            lappend optList [list -helpstr helpStr HelpStr {} $value]

            if { [info exists _opts($toolPath,-balloonstr)] } {

                set value $_opts($toolPath,-balloonstr)

            } else {

                set value {}

            }

            lappend optList [list -balloonstr balloonStr BalloonStr {} $value]

            return $optList

        }

        1 {

            # show only option specified

            # ''''''''''''''''''''''''''

            # did we satisfy the option get request?

            if { [regexp -- {-helpstr} $args] } {

                if { [info exists _opts($toolPath,-helpstr)] } {

                    set value $_opts($toolPath,-helpstr)

                } else {

                    set value {}

                }

                return [list -helpstr helpStr HelpStr {} $value]

            } elseif { [regexp -- {-balloonstr} $args] } {

                if { [info exists _opts($toolPath,-balloonstr)] } {

                    set value $_opts($toolPath,-balloonstr)

                } else {

                    set value {}

                }

                return [list -balloonstr balloonStr BalloonStr {} $value]

            } else {

                return [eval $toolPath configure $args]

            }

        }

        default {

            # ... do a normal configure

            # first screen for all our child options we are adding

            _setAttachedOption \

                    _opts \

                    $toolPath \

                    "-helpstr" \

                    $args

            _setAttachedOption \

                    _opts \

                    $toolPath \

                    "-balloonstr" \

                    $args

            # with a clean args list do a configure

            # if the stripping process brought us down to no options

            # to set, then forget the configure of widget.

            if { [llength $args] != 0 } {

                return [eval $toolPath configure $args]

            } else {

                return ""

            }

        }

    }

}

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

#

# METHOD: _resetBalloonDelay1

#

# Sets the delay that will occur before a balloon could be popped

# up to balloonDelay1

#

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

body iwidgets::Toolbar::_resetBalloonTimer {} {

    set _balloonTimer $itk_option(-balloondelay1)

    # reset the <1> longer delay

    set _balloonClick false

}

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

#

# METHOD: _startBalloonDelay

#

# Starts waiting to pop up a balloon id

#

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

body iwidgets::Toolbar::_startBalloonDelay {window} {

    set _balloonAfterID [after $_balloonTimer [code $this showBalloon $window]]

}

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

#

# METHOD: _stopBalloonDelay

#

# This method will stop the timer for a balloon popup if one is

# in progress. If however there is already a balloon window up

# it will hide the balloon window and set timing to delay 2 stage.

#

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

body iwidgets::Toolbar::_stopBalloonDelay { window balloonClick } {

    # If <1> then got a click cancel

    if { $balloonClick } {

        set _balloonClick true

    }

    if { $_balloonAfterID != 0 } {

        after cancel $_balloonAfterID

        set _balloonAfterID 0

    } else {

        hideBalloon

        # If this was cancelled with a <1> use longer delay.

        if { $_balloonClick } {

            set _balloonTimer $itk_option(-balloondelay1)

        } else {

            set _balloonTimer $itk_option(-balloondelay2)

        }

    }

}

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

# PRIVATE METHOD: _addWidget

#

# widgetCommand : command to invoke to create the added widget

# name          : name of the new widget to add

# args          : options for the widget create command

#

# Looks for -helpstr, -balloonstr and grabs them, strips from

# args list. Then tries to add a component and keeps based

# on known type. If it fails, it tries to clean up. Then it

# binds handlers for helpstatus and balloon help.

#

# Returns the path of the widget added.

#

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

body iwidgets::Toolbar::_addWidget { widgetCommand name args } {

    # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,

    # Add the widget to the tool bar

    # '''''''''''''''''''''''''''''''''''''''''''''''''''''

    # ... Strip out and save the -helpstr, -balloonstr options from args

    #     and save it in _opts

    _setAttachedOption \

            _opts \

            $_interior.$name \

            -helpstr \

            $args

    _setAttachedOption \

            _opts \

            $_interior.$name \

            -balloonstr \

            $args

    # ... Add the new widget as a component (catch an error if occurs)

    set createFailed [catch {

        itk_component add $name {

            eval $widgetCommand $_interior.$name $args

        } {

        }

    } errMsg]

    # ... Clean up if the create failed, and exit.

    #     The _opts list if it has -helpstr, -balloonstr just entered for

    #     this, it must be cleaned up.

    if { $createFailed } {

        # clean up

        if {![catch {set _opts($_interior.$name,-helpstr)}]} {

            set lastIndex [\

                    expr [llength \

                    $_opts($_interior.$name,-helpstr) ]-1]

            lreplace $_opts($_interior.$name,-helpstr) \

                    $lastIndex $lastIndex ""

        }

        if {![catch {set _opts($_interior.$name,-balloonstr)}]} {

            set lastIndex [\

                    expr [llength \

                    $_opts($_interior.$name,-balloonstr) ]-1]

            lreplace $_opts($_interior.$name,-balloonstr) \

                    $lastIndex $lastIndex ""

        }

        error $errMsg

    }

    # ... Add in dynamic options that apply from the _optionList

    foreach optionSet [$itk_component($name) configure] {

        set option [lindex $optionSet 0]

        if { [lsearch $_optionList $option] != -1 } {

            itk_option add $name.$option

        }

    }

    bindtags $itk_component($name) \

            [linsert [bindtags $itk_component($name)] end \

            toolbar-help-$itk_component(hull)]

    bindtags $itk_component($name) \

            [linsert [bindtags $itk_component($name)] end \

            toolbar-balloon-$itk_component(hull)]

    return $itk_component($name)

}

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

#

# PRIVATE METHOD: _deleteWidgets

#

# deletes widget range by numerical index numbers.

#

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

body iwidgets::Toolbar::_deleteWidgets { index1 index2 } {

    for { set index $index1 } { $index <= $index2 } { incr index } {

        # kill the widget

        set component [lindex $_toolList $index]

        destroy $component

    }

    # physically remove the page

    set _toolList [lreplace $_toolList $index1 $index2]

}

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

# PRIVATE METHOD: _index

#

# toolList : list of widget names to search thru if index

#            is non-numeric

# index    : either number, 'end', 'last', or pattern

#

# _index takes takes the value $index converts it to

# a numeric identifier. If the value is not already

# an integer it looks it up in the $toolList array.

# If it fails it returns -1

#

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

body iwidgets::Toolbar::_index { toolList index } {

    switch -- $index {

        end - last {

            set number [expr [llength $toolList] -1]

        }

        default {

            # is it a number already? Then just use the number

            if { [regexp {^[0-9]+$} $index] } {

                set number $index

                # check bounds

                if { $number < 0 || $number >= [llength $toolList] } {

                    set number -1

                }

                # otherwise it is a widget name

            } else {

                if { [catch { set itk_component($index) } ] } {

                    set number -1

                } else {

                    set number [lsearch -exact $toolList \

                            $itk_component($index)]

                }

            }

        }

    }

    return $number

}

# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

# STATUS HELP for linking to helpVariable

# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

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

#

# PUBLIC METHOD: hideHelp

#

# Bound to the  event on a toolbar widget. This clears the

# status widget help area and resets the help entry.

#

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

body iwidgets::Toolbar::hideHelp {} {

    if { $itk_option(-helpvariable) != {} } {

        upvar #0 $itk_option(-helpvariable) helpvar

        set helpvar {}

    }

    set _currHelpWidget {}

}

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

#

# PUBLIC METHOD: showHelp

#

# Bound to the  event on a tool bar widget. This puts the

# help string associated with the tool bar widget into the

# status widget help area. If no help exists for the current

# entry, the status widget is cleared.

#

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

body iwidgets::Toolbar::showHelp { window } {

    set widgetPath $window

    # already on this item?

    if { $window == $_currHelpWidget } {

        return

    }

    set _currHelpWidget $window

    # Do we have a helpvariable set on the toolbar?

    if { $itk_option(-helpvariable) != {} } {

        upvar #0 $itk_option(-helpvariable) helpvar

        # is the -helpstr set for this widget?

        set args "-helpstr"

        if {[_getAttachedOption _opts \

                $window args value]} {

            set helpvar $value.

        } else {

            set helpvar {}

        }

    }

}

# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

# BALLOON HELP for show/hide of hint window

# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

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

#

# PUBLIC METHOD: showBalloon

#

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

body iwidgets::Toolbar::showBalloon {window} {

    set _balloonClick false

    set _balloonAfterID 0

    # Are we still inside the window?

    set mouseWindow \

            [winfo containing [winfo pointerx .] [winfo pointery .]]

    if { [string match $window* $mouseWindow] } {

        # set up the balloonString

        set args "-balloonstr"

        if {[_getAttachedOption _opts \

                $window args hintStr]} {

            # configure the balloon help

            $_hintWindow.label configure -text $hintStr

            # Coordinates of the balloon

            set balloonLeft \

                    [expr [winfo rootx $window] + round(([winfo width $window]/2.0))]

            set balloonTop \

                    [expr [winfo rooty $window] + [winfo height $window]]

            # put up balloon window

            wm overrideredirect $_hintWindow 0

            wm geometry $_hintWindow "+$balloonLeft+$balloonTop"

            wm overrideredirect $_hintWindow 1

            wm deiconify $_hintWindow

            raise $_hintWindow

        } else {

            #NO BALLOON HELP AVAILABLE

        }

    } else {

        #NOT IN BUTTON

    }

}

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

#

# PUBLIC METHOD: hideBalloon

#

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

body iwidgets::Toolbar::hideBalloon {} {

    wm withdraw $_hintWindow

}

# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

# OPTION MANAGEMENT for -helpstr, -balloonstr

# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

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

# PRIVATE METHOD: _getAttachedOption

#

# optionListName : the name of the array that holds all attached

#              options. It is indexed via widget,option to get

#              the value.

# widget     : the widget that the option is associated with

# option     : the option whose value we are looking for on

#              this widget.

#

# expects to be called only if the $option is length 1

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

body iwidgets::Toolbar::_getAttachedOption { optionListName widget args retValue} {

    # get a reference to the option, so we can change it.

    upvar $args argsRef

    upvar $retValue retValueRef

    set success false

    if { ![catch { set retValueRef \

            [eval set [subst [set optionListName]]($widget,$argsRef)]}]} {

        # remove the option argument

        set success true

        set argsRef ""

    }

    return $success

}

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

# PRIVATE METHOD: _setAttachedOption

#

# This method allows us to attach new options to a widget. It

# catches the 'option' to be attached, strips it out of 'args'

# attaches it to the 'widget' by stuffing the value into

# 'optionList(widget,option)'

#

# optionListName:  where to store the option and widget association

# widget: is the widget we want to associate the attached option

# option: is the attached option (unknown to this widget)

# args:   the arg list to search and remove the option from (if found)

#

# Modifies the args parameter.

# Returns boolean indicating the success of the method

#

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

body iwidgets::Toolbar::_setAttachedOption {optionListName widget option args} {

    upvar args argsRef

    set success false

    # check for 'option' in the 'args' list for the 'widget'

    set optPos [eval lsearch $args $option]

    # ... found it

    if { $optPos != -1 } {

        # grab a copy of the option from arg list

        set [subst [set optionListName]]($widget,$option) \

                [eval lindex $args [expr $optPos + 1]]

        # remove the option argument and value from the arg list

        set argsRef [eval lreplace $args $optPos [expr $optPos + 1]]

        set success true

    }