home *** CD-ROM | disk | FTP | other *** search
/ PC World 2005 June / PCWorld_2005-06_cd.bin / software / vyzkuste / firewally / firewally.exe / framework-2.3.exe / toolbar.itk < prev    next >
Text File  |  2003-09-01  |  32KB  |  984 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.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. #
  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. itcl::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. # ------------------------------------------------------------------
  193. itcl::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. #
  234. proc ::iwidgets::toolbar {pathName args} {
  235.     uplevel ::iwidgets::Toolbar $pathName $args
  236. }
  237.  
  238. # ------------------------------------------------------------------
  239. #                           DESTURCTOR
  240. # ------------------------------------------------------------------
  241. itcl::body iwidgets::Toolbar::destructor {} {
  242.     if {$_balloonAfterID != 0} {after cancel $_balloonAfterID}
  243. }
  244.  
  245. # ------------------------------------------------------------------
  246. #                            OPTIONS
  247. # ------------------------------------------------------------------
  248.  
  249. # ------------------------------------------------------------------
  250. # OPTION -balloonbackground
  251. # ------------------------------------------------------------------
  252. itcl::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. # ------------------------------------------------------------------
  264. itcl::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. # ------------------------------------------------------------------
  276. itcl::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. # ------------------------------------------------------------------
  290. itcl::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. # -------------------------------------------------------------
  313. itcl::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. # -------------------------------------------------------------
  342. itcl::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. # -------------------------------------------------------------
  405. itcl::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. # -------------------------------------------------------------
  421. itcl::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. # ----------------------------------------------------------------------
  448. itcl::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. # -------------------------------------------------------------
  471. itcl::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. # -------------------------------------------------------------
  566. itcl::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. # -------------------------------------------------------------
  580. itcl::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. # -------------------------------------------------------------
  596. itcl::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. # -------------------------------------------------------------
  632. itcl::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. # -------------------------------------------------------------
  708. itcl::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. # -------------------------------------------------------------
  736. itcl::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. # -------------------------------------------------------------
  776. itcl::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. # -------------------------------------------------------------
  794. itcl::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. # -------------------------------------------------------------
  827. itcl::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. # -------------------------------------------------------------
  868. itcl::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. # -------------------------------------------------------------
  887. itcl::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. # -------------------------------------------------------------
  923. itcl::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. # -------------------------------------------------------------
  957. itcl::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.