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