1# 2# Toolbar 3# ---------------------------------------------------------------------- 4# 5# The Toolbar command creates a new window (given by the pathName 6# argument) and makes it into a Tool Bar widget. Additional options, 7# described above may be specified on the command line or in the 8# option database to configure aspects of the Toolbar such as its 9# colors, font, and orientation. The Toolbar command returns its 10# pathName argument. At the time this command is invoked, there 11# must not exist a window named pathName, but pathName's parent 12# must exist. 13# 14# A Toolbar is a widget that displays a collection of widgets arranged 15# either in a row or a column (depending on the value of the -orient 16# option). This collection of widgets is usually for user convenience 17# to give access to a set of commands or settings. Any widget may be 18# placed on a Toolbar. However, command or value-oriented widgets (such 19# as button, radiobutton, etc.) are usually the most useful kind of 20# widgets to appear on a Toolbar. 21# 22# WISH LIST: 23# This section lists possible future enhancements. 24# 25# Toggle between text and image/bitmap so that the toolbar could 26# display either all text or all image/bitmaps. 27# Implementation of the -toolbarfile option that allows toolbar 28# add commands to be read in from a file. 29# ---------------------------------------------------------------------- 30# AUTHOR: Bill W. Scott EMAIL: bscott@spd.dsccc.com 31# 32# @(#) $Id: toolbar.itk,v 1.5 2001/08/17 19:05:54 smithc Exp $ 33# ---------------------------------------------------------------------- 34# Copyright (c) 1995 DSC Technologies Corporation 35# ====================================================================== 36# Permission to use, copy, modify, distribute and license this software 37# and its documentation for any purpose, and without fee or written 38# agreement with DSC, is hereby granted, provided that the above copyright 39# notice appears in all copies and that both the copyright notice and 40# warranty disclaimer below appear in supporting documentation, and that 41# the names of DSC Technologies Corporation or DSC Communications 42# Corporation not be used in advertising or publicity pertaining to the 43# software without specific, written prior permission. 44# 45# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING 46# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- 47# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE 48# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, 49# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL 50# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR 51# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, 52# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, 53# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS 54# SOFTWARE. 55# ====================================================================== 56 57# 58# Default resources. 59# 60option add *Toolbar*padX 5 widgetDefault 61option add *Toolbar*padY 5 widgetDefault 62option add *Toolbar*orient horizontal widgetDefault 63option add *Toolbar*highlightThickness 0 widgetDefault 64option add *Toolbar*indicatorOn false widgetDefault 65option add *Toolbar*selectColor [. cget -bg] widgetDefault 66 67# 68# Usual options. 69# 70itk::usual Toolbar { 71 keep -activebackground -activeforeground -background -balloonbackground \ 72 -balloondelay1 -balloondelay2 -balloonfont -balloonforeground \ 73 -borderwidth -cursor -disabledforeground -font -foreground \ 74 -highlightbackground -highlightcolor -highlightthickness \ 75 -insertbackground -insertforeground -selectbackground \ 76 -selectborderwidth -selectcolor -selectforeground -troughcolor 77} 78 79# ------------------------------------------------------------------ 80# TOOLBAR 81# ------------------------------------------------------------------ 82itcl::class iwidgets::Toolbar { 83 inherit itk::Widget 84 85 constructor {args} {} 86 destructor {} 87 88 itk_option define -balloonbackground \ 89 balloonBackground BalloonBackground yellow 90 itk_option define -balloonforeground \ 91 balloonForeground BalloonForeground black 92 itk_option define -balloonfont balloonFont BalloonFont 6x10 93 itk_option define -balloondelay1 \ 94 balloonDelay1 BalloonDelay1 1000 95 itk_option define -balloondelay2 \ 96 balloonDelay2 BalloonDelay2 200 97 itk_option define -helpvariable helpVariable HelpVariable {} 98 itk_option define -orient orient Orient "horizontal" 99 100 # 101 # The following options implement propogated configurations to 102 # any widget that might be added to us. The problem is this is 103 # not deterministic as someone might add a new kind of widget with 104 # and option like -armbackground, so we would not be aware of 105 # this kind of option. Anyway we support as many of the obvious 106 # ones that we can. They can always configure them with itemconfigures. 107 # 108 itk_option define -activebackground activeBackground Foreground #c3c3c3 109 itk_option define -activeforeground activeForeground Background Black 110 itk_option define -background background Background #d9d9d9 111 itk_option define -borderwidth borderWidth BorderWidth 2 112 itk_option define -cursor cursor Cursor {} 113 itk_option define -disabledforeground \ 114 disabledForeground DisabledForeground #a3a3a3 115 itk_option define -font \ 116 font Font "-Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*" 117 itk_option define -foreground foreground Foreground #000000000000 118 itk_option define -highlightbackground \ 119 highlightBackground HighlightBackground #d9d9d9 120 itk_option define -highlightcolor highlightColor HighlightColor Black 121 itk_option define -highlightthickness \ 122 highlightThickness HighlightThickness 0 123 itk_option define -insertforeground insertForeground Background #c3c3c3 124 itk_option define -insertbackground insertBackground Foreground Black 125 itk_option define -selectbackground selectBackground Foreground #c3c3c3 126 itk_option define -selectborderwidth selectBorderWidth BorderWidth {} 127 itk_option define -selectcolor selectColor Background #b03060 128 itk_option define -selectforeground selectForeground Background Black 129 itk_option define -state state State normal 130 itk_option define -troughcolor troughColor Background #c3c3c3 131 132 public method add {widgetCommand name args} 133 public method delete {args} 134 public method index {index} 135 public method insert {beforeIndex widgetCommand name args} 136 public method itemcget {index args} 137 public method itemconfigure {index args} 138 139 public method _resetBalloonTimer {} 140 public method _startBalloonDelay {window} 141 public method _stopBalloonDelay {window balloonClick} 142 143 private method _deleteWidgets {index1 index2} 144 private method _addWidget {widgetCommand name args} 145 private method _index {toolList index} 146 private method _getAttachedOption {optionListName widget args retValue} 147 private method _setAttachedOption {optionListName widget option args} 148 private method _packToolbar {} 149 150 public method hideHelp {} 151 public method showHelp {window} 152 public method showBalloon {window} 153 public method hideBalloon {} 154 155 private variable _balloonTimer 0 156 private variable _balloonAfterID 0 157 private variable _balloonClick false 158 159 private variable _interior {} 160 private variable _initialMapping 1 ;# Is this the first mapping? 161 private variable _toolList {} ;# List of all widgets on toolbar 162 private variable _opts ;# New options for child widgets 163 private variable _currHelpWidget {} ;# Widget currently displaying help for 164 private variable _hintWindow {} ;# Balloon help bubble. 165 166 # list of options we want to propogate to widgets added to toolbar. 167 private common _optionList { 168 -activebackground \ 169 -activeforeground \ 170 -background \ 171 -borderwidth \ 172 -cursor \ 173 -disabledforeground \ 174 -font \ 175 -foreground \ 176 -highlightbackground \ 177 -highlightcolor \ 178 -highlightthickness \ 179 -insertbackground \ 180 -insertforeground \ 181 -selectbackground \ 182 -selectborderwidth \ 183 -selectcolor \ 184 -selectforeground \ 185 -state \ 186 -troughcolor \ 187 } 188} 189 190# ------------------------------------------------------------------ 191# CONSTRUCTOR 192# ------------------------------------------------------------------ 193itcl::body iwidgets::Toolbar::constructor {args} { 194 component hull configure -borderwidth 0 195 set _interior $itk_interior 196 197 # 198 # Handle configs 199 # 200 eval itk_initialize $args 201 202 # build balloon help window 203 set _hintWindow [toplevel $itk_component(hull).balloonHintWindow] 204 wm withdraw $_hintWindow 205 label $_hintWindow.label \ 206 -foreground $itk_option(-balloonforeground) \ 207 -background $itk_option(-balloonbackground) \ 208 -font $itk_option(-balloonfont) \ 209 -relief raised \ 210 -borderwidth 1 211 pack $_hintWindow.label 212 213 # ... Attach help handler to this widget 214 bind toolbar-help-$itk_component(hull) \ 215 <Enter> "+[itcl::code $this showHelp %W]" 216 bind toolbar-help-$itk_component(hull) \ 217 <Leave> "+[itcl::code $this hideHelp]" 218 219 # ... Set up Microsoft style balloon help display. 220 set _balloonTimer $itk_option(-balloondelay1) 221 bind $_interior \ 222 <Leave> "+[itcl::code $this _resetBalloonTimer]" 223 bind toolbar-balloon-$itk_component(hull) \ 224 <Enter> "+[itcl::code $this _startBalloonDelay %W]" 225 bind toolbar-balloon-$itk_component(hull) \ 226 <Leave> "+[itcl::code $this _stopBalloonDelay %W false]" 227 bind toolbar-balloon-$itk_component(hull) \ 228 <Button-1> "+[itcl::code $this _stopBalloonDelay %W true]" 229} 230 231# 232# Provide a lowercase access method for the Toolbar class 233# 234proc ::iwidgets::toolbar {pathName args} { 235 uplevel ::iwidgets::Toolbar $pathName $args 236} 237 238# ------------------------------------------------------------------ 239# DESTURCTOR 240# ------------------------------------------------------------------ 241itcl::body iwidgets::Toolbar::destructor {} { 242 if {$_balloonAfterID != 0} {after cancel $_balloonAfterID} 243} 244 245# ------------------------------------------------------------------ 246# OPTIONS 247# ------------------------------------------------------------------ 248 249# ------------------------------------------------------------------ 250# OPTION -balloonbackground 251# ------------------------------------------------------------------ 252itcl::configbody iwidgets::Toolbar::balloonbackground { 253 if { $_hintWindow != {} } { 254 if { $itk_option(-balloonbackground) != {} } { 255 $_hintWindow.label configure \ 256 -background $itk_option(-balloonbackground) 257 } 258 } 259} 260 261# ------------------------------------------------------------------ 262# OPTION -balloonforeground 263# ------------------------------------------------------------------ 264itcl::configbody iwidgets::Toolbar::balloonforeground { 265 if { $_hintWindow != {} } { 266 if { $itk_option(-balloonforeground) != {} } { 267 $_hintWindow.label configure \ 268 -foreground $itk_option(-balloonforeground) 269 } 270 } 271} 272 273# ------------------------------------------------------------------ 274# OPTION -balloonfont 275# ------------------------------------------------------------------ 276itcl::configbody iwidgets::Toolbar::balloonfont { 277 if { $_hintWindow != {} } { 278 if { $itk_option(-balloonfont) != {} } { 279 $_hintWindow.label configure \ 280 -font $itk_option(-balloonfont) 281 } 282 } 283} 284 285# ------------------------------------------------------------------ 286# OPTION: -orient 287# 288# Position buttons either horizontally or vertically. 289# ------------------------------------------------------------------ 290itcl::configbody iwidgets::Toolbar::orient { 291 switch $itk_option(-orient) { 292 "horizontal" - "vertical" { 293 _packToolbar 294 } 295 default {error "Invalid orientation. Must be either \ 296 horizontal or vertical" 297 } 298 } 299} 300 301# ------------------------------------------------------------------ 302# METHODS 303# ------------------------------------------------------------------ 304 305# ------------------------------------------------------------- 306# METHOD: add widgetCommand name ?option value? 307# 308# Adds a widget with the command widgetCommand whose name is 309# name to the Toolbar. If widgetCommand is radiobutton 310# or checkbutton, its packing is slightly padded to match the 311# geometry of button widgets. 312# ------------------------------------------------------------- 313itcl::body iwidgets::Toolbar::add { widgetCommand name args } { 314 315 eval "_addWidget $widgetCommand $name $args" 316 317 lappend _toolList $itk_component($name) 318 319 if { $widgetCommand == "radiobutton" || \ 320 $widgetCommand == "checkbutton" } { 321 set iPad 1 322 } else { 323 set iPad 0 324 } 325 326 # repack the tool bar 327 _packToolbar 328 329 return $itk_component($name) 330 331} 332 333# ------------------------------------------------------------- 334# 335# METHOD: delete index ?index2? 336# 337# This command deletes all components between index and 338# index2 inclusive. If index2 is omitted then it defaults 339# to index. Returns an empty string 340# 341# ------------------------------------------------------------- 342itcl::body iwidgets::Toolbar::delete { args } { 343 # empty toolbar 344 if { $_toolList == {} } { 345 error "can't delete widget, no widgets in the Toolbar \ 346 \"$itk_component(hull)\"" 347 } 348 349 set len [llength $args] 350 switch -- $len { 351 1 { 352 set fromWidget [_index $_toolList [lindex $args 0]] 353 354 if { $fromWidget < 0 || $fromWidget >= [llength $_toolList] } { 355 error "bad Toolbar widget index in delete method: \ 356 should be between 0 and [expr {[llength $_toolList] - 1} ]" 357 } 358 359 set toWidget $fromWidget 360 _deleteWidgets $fromWidget $toWidget 361 } 362 363 2 { 364 set fromWidget [_index $_toolList [lindex $args 0]] 365 366 if { $fromWidget < 0 || $fromWidget >= [llength $_toolList] } { 367 error "bad Toolbar widget index1 in delete method: \ 368 should be between 0 and [expr {[llength $_toolList] - 1} ]" 369 } 370 371 set toWidget [_index $_toolList [lindex $args 1]] 372 373 if { $toWidget < 0 || $toWidget >= [llength $_toolList] } { 374 error "bad Toolbar widget index2 in delete method: \ 375 should be between 0 and [expr {[llength $_toolList] - 1} ]" 376 } 377 378 if { $fromWidget > $toWidget } { 379 error "bad Toolbar widget index1 in delete method: \ 380 index1 is greater than index2" 381 } 382 383 _deleteWidgets $fromWidget $toWidget 384 } 385 386 default { 387 # ... too few/many parameters passed 388 error "wrong # args: should be \ 389 \"$itk_component(hull) delete index1 ?index2?\"" 390 } 391 } 392 393 return {} 394} 395 396 397# ------------------------------------------------------------- 398# 399# METHOD: index index 400# 401# Returns the widget's numerical index for the entry corresponding 402# to index. If index is not found, -1 is returned 403# 404# ------------------------------------------------------------- 405itcl::body iwidgets::Toolbar::index { index } { 406 407 return [_index $_toolList $index] 408 409} 410 411# ------------------------------------------------------------- 412# 413# METHOD: insert beforeIndex widgetCommand name ?option value? 414# 415# Insert a new component named name with the command 416# widgetCommand before the com ponent specified by beforeIndex. 417# If widgetCommand is radiobutton or checkbutton, its packing 418# is slightly padded to match the geometry of button widgets. 419# 420# ------------------------------------------------------------- 421itcl::body iwidgets::Toolbar::insert { beforeIndex widgetCommand name args } { 422 423 set beforeIndex [_index $_toolList $beforeIndex] 424 425 if {$beforeIndex < 0 || $beforeIndex > [llength $_toolList] } { 426 error "bad toolbar entry index $beforeIndex" 427 } 428 429 eval "_addWidget $widgetCommand $name $args" 430 431 # linsert into list 432 set _toolList [linsert $_toolList $beforeIndex $itk_component($name)] 433 434 # repack the tool bar 435 _packToolbar 436 437 return $itk_component($name) 438 439} 440 441# ---------------------------------------------------------------------- 442# METHOD: itemcget index ?option? 443# 444# Returns the value for the option setting of the widget at index $index. 445# index can be numeric or widget name 446# 447# ---------------------------------------------------------------------- 448itcl::body iwidgets::Toolbar::itemcget { index args} { 449 450 return [lindex [eval itemconfigure $index $args] 4] 451} 452 453# ------------------------------------------------------------- 454# 455# METHOD: itemconfigure index ?option? ?value? ?option value...? 456# 457# Query or modify the configuration options of the widget of 458# the Toolbar specified by index. If no option is specified, 459# returns a list describing all of the available options for 460# index (see Tk_ConfigureInfo for information on the format 461# of this list). If option is specified with no value, then 462# the command returns a list describing the one named option 463# (this list will be identical to the corresponding sublist 464# of the value returned if no option is specified). If one 465# or more option-value pairs are specified, then the command 466# modifies the given widget option(s) to have the given 467# value(s); in this case the command returns an empty string. 468# The component type of index determines the valid available options. 469# 470# ------------------------------------------------------------- 471itcl::body iwidgets::Toolbar::itemconfigure { index args } { 472 473 # Get a numeric index. 474 set index [_index $_toolList $index] 475 476 # Get the tool path 477 set toolPath [lindex $_toolList $index] 478 479 set len [llength $args] 480 481 switch $len { 482 0 { 483 # show all options 484 # '''''''''''''''' 485 486 # support display of -helpstr and -balloonstr configs 487 set optList [$toolPath configure] 488 489 ## @@@ might want to use _getAttachedOption instead... 490 if { [info exists _opts($toolPath,-helpstr)] } { 491 set value $_opts($toolPath,-helpstr) 492 } else { 493 set value {} 494 } 495 lappend optList [list -helpstr helpStr HelpStr {} $value] 496 if { [info exists _opts($toolPath,-balloonstr)] } { 497 set value $_opts($toolPath,-balloonstr) 498 } else { 499 set value {} 500 } 501 lappend optList [list -balloonstr balloonStr BalloonStr {} $value] 502 return $optList 503 } 504 1 { 505 # show only option specified 506 # '''''''''''''''''''''''''' 507 # did we satisfy the option get request? 508 509 if { [regexp -- {-helpstr} $args] } { 510 if { [info exists _opts($toolPath,-helpstr)] } { 511 set value $_opts($toolPath,-helpstr) 512 } else { 513 set value {} 514 } 515 return [list -helpstr helpStr HelpStr {} $value] 516 } elseif { [regexp -- {-balloonstr} $args] } { 517 if { [info exists _opts($toolPath,-balloonstr)] } { 518 set value $_opts($toolPath,-balloonstr) 519 } else { 520 set value {} 521 } 522 return [list -balloonstr balloonStr BalloonStr {} $value] 523 } else { 524 return [eval $toolPath configure $args] 525 } 526 527 } 528 default { 529 # ... do a normal configure 530 531 # first screen for all our child options we are adding 532 _setAttachedOption \ 533 _opts \ 534 $toolPath \ 535 "-helpstr" \ 536 $args 537 538 _setAttachedOption \ 539 _opts \ 540 $toolPath \ 541 "-balloonstr" \ 542 $args 543 544 # with a clean args list do a configure 545 546 # if the stripping process brought us down to no options 547 # to set, then forget the configure of widget. 548 if { [llength $args] != 0 } { 549 return [eval $toolPath configure $args] 550 } else { 551 return "" 552 } 553 } 554 } 555 556} 557 558# ------------------------------------------------------------- 559# 560# METHOD: _resetBalloonDelay1 561# 562# Sets the delay that will occur before a balloon could be popped 563# up to balloonDelay1 564# 565# ------------------------------------------------------------- 566itcl::body iwidgets::Toolbar::_resetBalloonTimer {} { 567 set _balloonTimer $itk_option(-balloondelay1) 568 569 # reset the <1> longer delay 570 set _balloonClick false 571} 572 573# ------------------------------------------------------------- 574# 575# METHOD: _startBalloonDelay 576# 577# Starts waiting to pop up a balloon id 578# 579# ------------------------------------------------------------- 580itcl::body iwidgets::Toolbar::_startBalloonDelay {window} { 581 if {$_balloonAfterID != 0} { 582 after cancel $_balloonAfterID 583 } 584 set _balloonAfterID [after $_balloonTimer [itcl::code $this showBalloon $window]] 585} 586 587# ------------------------------------------------------------- 588# 589# METHOD: _stopBalloonDelay 590# 591# This method will stop the timer for a balloon popup if one is 592# in progress. If however there is already a balloon window up 593# it will hide the balloon window and set timing to delay 2 stage. 594# 595# ------------------------------------------------------------- 596itcl::body iwidgets::Toolbar::_stopBalloonDelay { window balloonClick } { 597 598 # If <1> then got a click cancel 599 if { $balloonClick } { 600 set _balloonClick true 601 } 602 if { $_balloonAfterID != 0 } { 603 after cancel $_balloonAfterID 604 set _balloonAfterID 0 605 } else { 606 hideBalloon 607 608 # If this was cancelled with a <1> use longer delay. 609 if { $_balloonClick } { 610 set _balloonTimer $itk_option(-balloondelay1) 611 } else { 612 set _balloonTimer $itk_option(-balloondelay2) 613 } 614 } 615} 616 617# ------------------------------------------------------------- 618# PRIVATE METHOD: _addWidget 619# 620# widgetCommand : command to invoke to create the added widget 621# name : name of the new widget to add 622# args : options for the widget create command 623# 624# Looks for -helpstr, -balloonstr and grabs them, strips from 625# args list. Then tries to add a component and keeps based 626# on known type. If it fails, it tries to clean up. Then it 627# binds handlers for helpstatus and balloon help. 628# 629# Returns the path of the widget added. 630# 631# ------------------------------------------------------------- 632itcl::body iwidgets::Toolbar::_addWidget { widgetCommand name args } { 633 634 # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 635 # Add the widget to the tool bar 636 # ''''''''''''''''''''''''''''''''''''''''''''''''''''' 637 638 # ... Strip out and save the -helpstr, -balloonstr options from args 639 # and save it in _opts 640 _setAttachedOption \ 641 _opts \ 642 $_interior.$name \ 643 -helpstr \ 644 $args 645 646 _setAttachedOption \ 647 _opts \ 648 $_interior.$name \ 649 -balloonstr \ 650 $args 651 652 653 # ... Add the new widget as a component (catch an error if occurs) 654 set createFailed [catch { 655 itk_component add $name { 656 eval $widgetCommand $_interior.$name $args 657 } { 658 } 659 } errMsg] 660 661 # ... Clean up if the create failed, and exit. 662 # The _opts list if it has -helpstr, -balloonstr just entered for 663 # this, it must be cleaned up. 664 if { $createFailed } { 665 # clean up 666 if {![catch {set _opts($_interior.$name,-helpstr)}]} { 667 set lastIndex [\ 668 expr {[llength \ 669 $_opts($_interior.$name,-helpstr) ]-1}] 670 lreplace $_opts($_interior.$name,-helpstr) \ 671 $lastIndex $lastIndex "" 672 } 673 if {![catch {set _opts($_interior.$name,-balloonstr)}]} { 674 set lastIndex [\ 675 expr {[llength \ 676 $_opts($_interior.$name,-balloonstr) ]-1}] 677 lreplace $_opts($_interior.$name,-balloonstr) \ 678 $lastIndex $lastIndex "" 679 } 680 error $errMsg 681 } 682 683 # ... Add in dynamic options that apply from the _optionList 684 foreach optionSet [$itk_component($name) configure] { 685 set option [lindex $optionSet 0] 686 if { [lsearch $_optionList $option] != -1 } { 687 itk_option add $name.$option 688 } 689 } 690 691 bindtags $itk_component($name) \ 692 [linsert [bindtags $itk_component($name)] end \ 693 toolbar-help-$itk_component(hull)] 694 bindtags $itk_component($name) \ 695 [linsert [bindtags $itk_component($name)] end \ 696 toolbar-balloon-$itk_component(hull)] 697 698 return $itk_component($name) 699} 700 701# ------------------------------------------------------------- 702# 703# PRIVATE METHOD: _deleteWidgets 704# 705# deletes widget range by numerical index numbers. 706# 707# ------------------------------------------------------------- 708itcl::body iwidgets::Toolbar::_deleteWidgets { index1 index2 } { 709 710 for { set index $index1 } { $index <= $index2 } { incr index } { 711 712 # kill the widget 713 set component [lindex $_toolList $index] 714 destroy $component 715 716 } 717 718 # physically remove the page 719 set _toolList [lreplace $_toolList $index1 $index2] 720 721} 722 723# ------------------------------------------------------------- 724# PRIVATE METHOD: _index 725# 726# toolList : list of widget names to search thru if index 727# is non-numeric 728# index : either number, 'end', 'last', or pattern 729# 730# _index takes takes the value $index converts it to 731# a numeric identifier. If the value is not already 732# an integer it looks it up in the $toolList array. 733# If it fails it returns -1 734# 735# ------------------------------------------------------------- 736itcl::body iwidgets::Toolbar::_index { toolList index } { 737 738 switch -- $index { 739 end - last { 740 set number [expr {[llength $toolList] -1}] 741 } 742 default { 743 # is it a number already? Then just use the number 744 if { [regexp {^[0-9]+$} $index] } { 745 set number $index 746 # check bounds 747 if { $number < 0 || $number >= [llength $toolList] } { 748 set number -1 749 } 750 # otherwise it is a widget name 751 } else { 752 if { [catch { set itk_component($index) } ] } { 753 set number -1 754 } else { 755 set number [lsearch -exact $toolList \ 756 $itk_component($index)] 757 } 758 } 759 } 760 } 761 762 return $number 763} 764 765# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 766# STATUS HELP for linking to helpVariable 767# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 768# ------------------------------------------------------------- 769# 770# PUBLIC METHOD: hideHelp 771# 772# Bound to the <Leave> event on a toolbar widget. This clears the 773# status widget help area and resets the help entry. 774# 775# ------------------------------------------------------------- 776itcl::body iwidgets::Toolbar::hideHelp {} { 777 if { $itk_option(-helpvariable) != {} } { 778 upvar #0 $itk_option(-helpvariable) helpvar 779 set helpvar {} 780 } 781 set _currHelpWidget {} 782} 783 784# ------------------------------------------------------------- 785# 786# PUBLIC METHOD: showHelp 787# 788# Bound to the <Motion> event on a tool bar widget. This puts the 789# help string associated with the tool bar widget into the 790# status widget help area. If no help exists for the current 791# entry, the status widget is cleared. 792# 793# ------------------------------------------------------------- 794itcl::body iwidgets::Toolbar::showHelp { window } { 795 796 set widgetPath $window 797 # already on this item? 798 if { $window == $_currHelpWidget } { 799 return 800 } 801 802 set _currHelpWidget $window 803 804 # Do we have a helpvariable set on the toolbar? 805 if { $itk_option(-helpvariable) != {} } { 806 upvar #0 $itk_option(-helpvariable) helpvar 807 808 # is the -helpstr set for this widget? 809 set args "-helpstr" 810 if {[_getAttachedOption _opts \ 811 $window args value]} { 812 set helpvar $value. 813 } else { 814 set helpvar {} 815 } 816 } 817} 818 819# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 820# BALLOON HELP for show/hide of hint window 821# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 822# ------------------------------------------------------------- 823# 824# PUBLIC METHOD: showBalloon 825# 826# ------------------------------------------------------------- 827itcl::body iwidgets::Toolbar::showBalloon {window} { 828 set _balloonClick false 829 set _balloonAfterID 0 830 # Are we still inside the window? 831 set mouseWindow \ 832 [winfo containing [winfo pointerx .] [winfo pointery .]] 833 834 if { [string match $window* $mouseWindow] } { 835 # set up the balloonString 836 set args "-balloonstr" 837 if {[_getAttachedOption _opts \ 838 $window args hintStr]} { 839 # configure the balloon help 840 $_hintWindow.label configure -text $hintStr 841 842 # Coordinates of the balloon 843 set balloonLeft \ 844 [expr {[winfo rootx $window] + round(([winfo width $window]/2.0))}] 845 set balloonTop \ 846 [expr {[winfo rooty $window] + [winfo height $window]}] 847 848 # put up balloon window 849 wm overrideredirect $_hintWindow 0 850 wm geometry $_hintWindow "+$balloonLeft+$balloonTop" 851 wm overrideredirect $_hintWindow 1 852 wm deiconify $_hintWindow 853 raise $_hintWindow 854 } else { 855 #NO BALLOON HELP AVAILABLE 856 } 857 } else { 858 #NOT IN BUTTON 859 } 860 861} 862 863# ------------------------------------------------------------- 864# 865# PUBLIC METHOD: hideBalloon 866# 867# ------------------------------------------------------------- 868itcl::body iwidgets::Toolbar::hideBalloon {} { 869 wm withdraw $_hintWindow 870} 871 872# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 873# OPTION MANAGEMENT for -helpstr, -balloonstr 874# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 875# ------------------------------------------------------------- 876# PRIVATE METHOD: _getAttachedOption 877# 878# optionListName : the name of the array that holds all attached 879# options. It is indexed via widget,option to get 880# the value. 881# widget : the widget that the option is associated with 882# option : the option whose value we are looking for on 883# this widget. 884# 885# expects to be called only if the $option is length 1 886# ------------------------------------------------------------- 887itcl::body iwidgets::Toolbar::_getAttachedOption { optionListName widget args retValue} { 888 889 # get a reference to the option, so we can change it. 890 upvar $args argsRef 891 upvar $retValue retValueRef 892 893 set success false 894 895 if { ![catch { set retValueRef \ 896 [eval set [subst [set optionListName]]($widget,$argsRef)]}]} { 897 898 # remove the option argument 899 set success true 900 set argsRef "" 901 } 902 903 return $success 904} 905 906# ------------------------------------------------------------- 907# PRIVATE METHOD: _setAttachedOption 908# 909# This method allows us to attach new options to a widget. It 910# catches the 'option' to be attached, strips it out of 'args' 911# attaches it to the 'widget' by stuffing the value into 912# 'optionList(widget,option)' 913# 914# optionListName: where to store the option and widget association 915# widget: is the widget we want to associate the attached option 916# option: is the attached option (unknown to this widget) 917# args: the arg list to search and remove the option from (if found) 918# 919# Modifies the args parameter. 920# Returns boolean indicating the success of the method 921# 922# ------------------------------------------------------------- 923itcl::body iwidgets::Toolbar::_setAttachedOption {optionListName widget option args} { 924 925 upvar args argsRef 926 927 set success false 928 929 # check for 'option' in the 'args' list for the 'widget' 930 set optPos [eval lsearch $args $option] 931 932 # ... found it 933 if { $optPos != -1 } { 934 # grab a copy of the option from arg list 935 set [subst [set optionListName]]($widget,$option) \ 936 [eval lindex $args [expr {$optPos + 1}]] 937 938 # remove the option argument and value from the arg list 939 set argsRef [eval lreplace $args $optPos [expr {$optPos + 1}]] 940 set success true 941 } 942 # ... if not found, will leave args alone 943 944 return $success 945} 946 947# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 948# GEOMETRY MANAGEMENT for tool widgets 949# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 950# ------------------------------------------------------------- 951# 952# PRIVATE METHOD: _packToolbar 953# 954# 955# 956# ------------------------------------------------------------- 957itcl::body iwidgets::Toolbar::_packToolbar {} { 958 959 # forget the previous locations 960 foreach tool $_toolList { 961 pack forget $tool 962 } 963 964 # pack in order of _toolList. 965 foreach tool $_toolList { 966 # adjust for radios and checks to match buttons 967 if { [winfo class $tool] == "Radiobutton" || 968 [winfo class $tool] == "Checkbutton" } { 969 set iPad 1 970 } else { 971 set iPad 0 972 } 973 974 # pack by horizontal or vertical orientation 975 if {$itk_option(-orient) == "horizontal" } { 976 pack $tool -side left -fill y \ 977 -ipadx $iPad -ipady $iPad 978 } else { 979 pack $tool -side top -fill x \ 980 -ipadx $iPad -ipady $iPad 981 } 982 } 983} 984