diff options
Diffstat (limited to 'itcl/iwidgets/generic/toolbar.itk')
| -rw-r--r-- | itcl/iwidgets/generic/toolbar.itk | 983 |
1 files changed, 983 insertions, 0 deletions
diff --git a/itcl/iwidgets/generic/toolbar.itk b/itcl/iwidgets/generic/toolbar.itk new file mode 100644 index 00000000000..f49d7aa8348 --- /dev/null +++ b/itcl/iwidgets/generic/toolbar.itk @@ -0,0 +1,983 @@ +# +# 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$ +# ---------------------------------------------------------------------- +# 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 +# ------------------------------------------------------------------ +itcl::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 +# ------------------------------------------------------------------ +itcl::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) \ + <Enter> "+[itcl::code $this showHelp %W]" + bind toolbar-help-$itk_component(hull) \ + <Leave> "+[itcl::code $this hideHelp]" + + # ... Set up Microsoft style balloon help display. + set _balloonTimer $itk_option(-balloondelay1) + bind $_interior \ + <Leave> "+[itcl::code $this _resetBalloonTimer]" + bind toolbar-balloon-$itk_component(hull) \ + <Enter> "+[itcl::code $this _startBalloonDelay %W]" + bind toolbar-balloon-$itk_component(hull) \ + <Leave> "+[itcl::code $this _stopBalloonDelay %W false]" + bind toolbar-balloon-$itk_component(hull) \ + <Button-1> "+[itcl::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 +# ------------------------------------------------------------------ +itcl::body iwidgets::Toolbar::destructor {} { + if {$_balloonAfterID != 0} {after cancel $_balloonAfterID} +} + +# ------------------------------------------------------------------ +# OPTIONS +# ------------------------------------------------------------------ + +# ------------------------------------------------------------------ +# OPTION -balloonbackground +# ------------------------------------------------------------------ +itcl::configbody iwidgets::Toolbar::balloonbackground { + if { $_hintWindow != {} } { + if { $itk_option(-balloonbackground) != {} } { + $_hintWindow.label configure \ + -background $itk_option(-balloonbackground) + } + } +} + +# ------------------------------------------------------------------ +# OPTION -balloonforeground +# ------------------------------------------------------------------ +itcl::configbody iwidgets::Toolbar::balloonforeground { + if { $_hintWindow != {} } { + if { $itk_option(-balloonforeground) != {} } { + $_hintWindow.label configure \ + -foreground $itk_option(-balloonforeground) + } + } +} + +# ------------------------------------------------------------------ +# OPTION -balloonfont +# ------------------------------------------------------------------ +itcl::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. +# ------------------------------------------------------------------ +itcl::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. +# ------------------------------------------------------------- +itcl::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 +# +# ------------------------------------------------------------- +itcl::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 +# +# ------------------------------------------------------------- +itcl::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. +# +# ------------------------------------------------------------- +itcl::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 +# +# ---------------------------------------------------------------------- +itcl::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. +# +# ------------------------------------------------------------- +itcl::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 { + 0 { + # 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 +# +# ------------------------------------------------------------- +itcl::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 +# +# ------------------------------------------------------------- +itcl::body iwidgets::Toolbar::_startBalloonDelay {window} { + if {$_balloonAfterID != 0} { + after cancel $_balloonAfterID + } + set _balloonAfterID [after $_balloonTimer [itcl::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. +# +# ------------------------------------------------------------- +itcl::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. +# +# ------------------------------------------------------------- +itcl::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. +# +# ------------------------------------------------------------- +itcl::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 +# +# ------------------------------------------------------------- +itcl::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 <Leave> event on a toolbar widget. This clears the +# status widget help area and resets the help entry. +# +# ------------------------------------------------------------- +itcl::body iwidgets::Toolbar::hideHelp {} { + if { $itk_option(-helpvariable) != {} } { + upvar #0 $itk_option(-helpvariable) helpvar + set helpvar {} + } + set _currHelpWidget {} +} + +# ------------------------------------------------------------- +# +# PUBLIC METHOD: showHelp +# +# Bound to the <Motion> 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. +# +# ------------------------------------------------------------- +itcl::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 +# +# ------------------------------------------------------------- +itcl::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 +# +# ------------------------------------------------------------- +itcl::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 +# ------------------------------------------------------------- +itcl::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 +# +# ------------------------------------------------------------- +itcl::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 + } + # ... if not found, will leave args alone + + return $success +} + +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +# GEOMETRY MANAGEMENT for tool widgets +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +# ------------------------------------------------------------- +# +# PRIVATE METHOD: _packToolbar +# +# +# +# ------------------------------------------------------------- +itcl::body iwidgets::Toolbar::_packToolbar {} { + + # forget the previous locations + foreach tool $_toolList { + pack forget $tool + } + + # pack in order of _toolList. + foreach tool $_toolList { + # adjust for radios and checks to match buttons + if { [winfo class $tool] == "Radiobutton" || + [winfo class $tool] == "Checkbutton" } { + set iPad 1 + } else { + set iPad 0 + } + + # pack by horizontal or vertical orientation + if {$itk_option(-orient) == "horizontal" } { + pack $tool -side left -fill y \ + -ipadx $iPad -ipady $iPad + } else { + pack $tool -side top -fill x \ + -ipadx $iPad -ipady $iPad + } + } +} |