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 / menubar.itk < prev    next >
Text File  |  1999-02-24  |  76KB  |  2,531 lines
  1. #
  2. # Menubar widget
  3. # ----------------------------------------------------------------------
  4. # The Menubar command creates a new window (given by the pathName 
  5. # argument) and makes it into a Pull down menu widget. Additional 
  6. # options, described above may be specified on the command line or 
  7. # in the option database to configure aspects of the Menubar such 
  8. # as its colors and font. The Menubar command returns its pathName 
  9. # argument. At the time this command is invoked, there must not exist 
  10. # a window named pathName, but pathName's parent must exist.
  11. # 
  12. # A Menubar is a widget that simplifies the task of creating 
  13. # menu hierarchies. It encapsulates a frame widget, as well 
  14. # as menubuttons, menus, and menu entries. The Menubar allows 
  15. # menus to be specified and refer enced in a more consistent 
  16. # manner than using Tk to build menus directly. First, Menubar
  17. # allows a menu tree to be expressed in a hierachical "language". 
  18. # The Menubar accepts a menuButtons option that allows a list of 
  19. # menubuttons to be added to the Menubar. In turn, each menubutton
  20. # accepts a menu option that spec ifies a list of menu entries 
  21. # to be added to the menubutton's menu (as well as an option 
  22. # set for the menu).   Cascade entries in turn, accept a menu 
  23. # option that specifies a list of menu entries to be added to 
  24. # the cascade's menu (as well as an option set for the menu). In 
  25. # this manner, a complete menu grammar can be expressed to the 
  26. # Menubar. Additionally, the Menubar allows each component of 
  27. # the Menubar system to be referenced by a simple componentPathName 
  28. # syntax. Finally, the Menubar extends the option set of menu 
  29. # entries to include the helpStr option used to implement status 
  30. # bar help.
  31. #
  32. # WISH LIST:
  33. #   This section lists possible future enhancements.
  34. #
  35. # ----------------------------------------------------------------------
  36. #  AUTHOR: Bill W. Scott                 EMAIL: bscott@spd.dsccc.com
  37. #
  38. #  @(#) $Id: menubar.itk,v 1.1 1998/07/27 18:49:34 stanton Exp $
  39. # ----------------------------------------------------------------------
  40. #            Copyright (c) 1995 DSC Technologies Corporation
  41. # ======================================================================
  42. # Permission to use, copy, modify, distribute and license this software 
  43. # and its documentation for any purpose, and without fee or written 
  44. # agreement with DSC, is hereby granted, provided that the above copyright 
  45. # notice appears in all copies and that both the copyright notice and 
  46. # warranty disclaimer below appear in supporting documentation, and that 
  47. # the names of DSC Technologies Corporation or DSC Communications 
  48. # Corporation not be used in advertising or publicity pertaining to the 
  49. # software without specific, written prior permission.
  50. # 
  51. # DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING 
  52. # ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
  53. # INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
  54. # AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, 
  55. # SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL 
  56. # DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR 
  57. # ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, 
  58. # WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
  59. # ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS 
  60. # SOFTWARE.
  61. # ======================================================================
  62.  
  63.  
  64. #
  65. # Option database default resources:
  66. #
  67. option add *Menubar*Menu*tearOff         false        widgetDefault
  68. option add *Menubar*activeBorderWidth 2               widgetDefault
  69. option add *Menubar*activeForeground black            widgetDefault
  70. option add *Menubar*anchor center                     widgetDefault
  71. option add *Menubar*borderWidth 2                     widgetDefault
  72. option add *Menubar*disabledForeground #a3a3a3        widgetDefault
  73. option add *Menubar*font \
  74.     "-Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*" widgetDefault
  75. option add *Menubar*highlightBackground #d9d9d9       widgetDefault
  76. option add *Menubar*highlightColor Black              widgetDefault
  77. option add *Menubar*highlightThickness 0              widgetDefault
  78. option add *Menubar*justify center                    widgetDefault
  79. option add *Menubar*padX 4p                           widgetDefault
  80. option add *Menubar*padY 3p                           widgetDefault
  81. option add *Menubar*Menubutton*relief flat            widgetDefault
  82. option add *Menubar*Menu*relief raised                widgetDefault
  83. option add *Menubar*wrapLength 0                      widgetDefault
  84.  
  85. #
  86. # Usual options.
  87. #
  88. itk::usual Menubar {
  89.     keep -activebackground -activeborderwidth -activeforeground
  90.     keep -background -cursor -disabledforeground -foreground
  91.     keep -font
  92. }
  93.  
  94. #
  95. # The Option class
  96. #
  97. # This class implements the concept of an option.
  98. #
  99. class iwidgets::Option {
  100.  
  101.     #
  102.     # CONSTRUCTOR
  103.     #
  104.     constructor { args } {
  105.  
  106.         if { $args != "" } {
  107.             uplevel $this configure $args
  108.         }
  109.  
  110.     }
  111.  
  112.     #==============================================================
  113.     # O P T I O N S
  114.     #==============================================================
  115.     public variable switch {} { }
  116.     public variable name {} { }
  117.     public variable class {} { }
  118.     public variable default {} { }
  119.     public variable value {} { }
  120.  
  121.     #==============================================================
  122.     # P U B L I C    I N T E R F A C E
  123.     #==============================================================
  124.     public method set { args } { }
  125.     public method get { args } { }
  126.  
  127.  
  128.     #==============================================================
  129.     # D E S T R U C T O R
  130.     #==============================================================
  131.     destructor {
  132.     }
  133. }
  134.  
  135. #==============================================================
  136. # P U B L I C    I M P L E M E N T A T I O N
  137. #==============================================================
  138.  
  139. #
  140. # OPTION -switch
  141. #
  142. # This option specifies the switch name for the option
  143. #
  144. configbody iwidgets::Option::switch {
  145. }
  146.  
  147. #
  148. # OPTION -name
  149. #
  150. # This option specifies the resource name for the option
  151. #
  152. configbody iwidgets::Option::name {
  153. }
  154.  
  155. #
  156. # OPTION -class
  157. #
  158. # This option specifies the resource class for the option
  159. #
  160. configbody iwidgets::Option::class {
  161. }
  162.  
  163. #
  164. # OPTION -default
  165. #
  166. # This option specifies the default value for the option
  167. #
  168. configbody iwidgets::Option::default {
  169. }
  170.  
  171. #
  172. # OPTION -value
  173. #
  174. # This option specifies the current value for the option
  175. #
  176. configbody iwidgets::Option::value {
  177. }
  178.  
  179.  
  180. body iwidgets::Option::get { args } {
  181.  
  182.     upvar $args argsRef
  183.  
  184.     ::set len [llength $args]
  185.  
  186.     switch $len {
  187.         0 {
  188.             return [list $switch $name $class $default $value]
  189.         }
  190.         1 {
  191.             if { [string match $args $switch] } {
  192.                 return [list $switch $name $class $default $value]
  193.                 #::set argsRef {}
  194.                 #return $value
  195.             } else {
  196.                 return {}
  197.             }
  198.         }
  199.         default {
  200.             error "wrong # arguments: \
  201.                     should be \"$itk_component(hull) get ?option?\""
  202.         }
  203.     }
  204.  
  205. }
  206.  
  207. body iwidgets::Option::set { args } {
  208.     # scan args for our switch.
  209.     # if found, set our -value option and strip args.
  210.     # else do nothing.
  211.  
  212.     upvar args argsRef
  213.  
  214.     ::set success false
  215.  
  216.     # check for 'option' in the 'args' list
  217.     ::set optPos [lsearch $args $switch]
  218.  
  219.     # ... found it
  220.     if { $optPos != -1 } {
  221.         # set our -value switch
  222.         ::set value [lindex $args [expr $optPos + 1]]
  223.  
  224.         # remove the option argument and value from the arg list
  225.         ::set argsRef [lreplace $args $optPos [expr $optPos + 1]]
  226.         ::set success true
  227.     }
  228.  
  229.     return $success
  230. }
  231.  
  232. class iwidgets::MenuOption {
  233.     inherit iwidgets::Option
  234.     constructor { args } {}
  235. }
  236. body iwidgets::MenuOption::constructor { args } {
  237.     uplevel $this configure \
  238.             -switch -menu -name menu -class Menu -default {} -value {}
  239. }
  240.  
  241. class iwidgets::HelpStrOption {
  242.     inherit iwidgets::Option
  243.     constructor { args } {}
  244. }
  245. body iwidgets::HelpStrOption::constructor { args } {
  246.     uplevel $this configure \
  247.         -switch -helpstr -name helpStr -class HelpStr -default {{}} -value {{}}
  248. }
  249.  
  250. class iwidgets::Menubar {
  251.     inherit itk::Widget
  252.  
  253.     constructor { args } {}
  254.  
  255.     itk_option define -foreground foreground Foreground Black
  256.     itk_option define -activebackground activeBackground Foreground "#ececec"
  257.     itk_option define -activeborderwidth activeBorderWidth BorderWidth 2 
  258.     itk_option define -activeforeground activeForeground Background black
  259.     itk_option define -anchor anchor Anchor {}
  260.     itk_option define -borderwidth borderWidth BorderWidth {} 
  261.     itk_option define \
  262.         -disabledforeground disabledForeground DisabledForeground #a3a3a3 
  263.     itk_option define \
  264.         -font font Font "-Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*"
  265.     itk_option define \
  266.         -highlightbackground highlightBackground HighlightBackground #d9d9d9
  267.     itk_option define -highlightcolor highlightColor HighlightColor Black
  268.     itk_option define \
  269.         -highlightthickness highlightThickness HighlightThickness {}
  270.     itk_option define -justify justify Justify {}
  271.     itk_option define -padx padX Pad {}
  272.     itk_option define -pady padY Pad {}
  273.     itk_option define -wraplength wrapLength WrapLength {}
  274.     itk_option define -menubuttons menuButtons MenuButtons {}
  275.     itk_option define -helpvariable helpVariable HelpVariable {}
  276.  
  277.     public method add { type path args } { }
  278.     public method delete { args } { }
  279.     public method index { path } { }
  280.     public method insert { beforeComponent type name args }
  281.     public method invoke { entryPath } { }
  282.     public method menucget { args } { }
  283.     public method menuconfigure { path args } { }
  284.     public method path { args } { }
  285.     public method type { path } { }
  286.     public method yposition { entryPath } { }
  287.  
  288.     public method _leaveHandler { menuPath } { }
  289.     public method _helpHandler { menuPath menuY } { }
  290.  
  291.     private method menubutton { menuName args } { }
  292.     private method options { args } { }
  293.     private method command { cmdName args } { }
  294.     private method checkbutton { chkName args } { }
  295.     private method radiobutton { radName args } { }
  296.     private method separator { sepName args } { }
  297.     private method cascade { casName args } { }
  298.     private method _addMenuButton { buttonName args} { }
  299.     private method _insertMenuButton { beforeMenuPath buttonName args} { }
  300.     private method _makeMenuButton {buttonName args} { }
  301.     private method _makeMenu { buttonName menuEvalStr } { }
  302.     private method _substEvalStr { evalStr } { }
  303.     private method _deleteMenu { args } { }
  304.     private method _deleteAMenu { path } { }
  305.     private method _addEntry { type path args } { }
  306.     private method _addCascade { tkMenuPath path args } { }
  307.     private method _makeCascadeMenu \
  308.                     { tkMenuPath parentPath cascadeName menuEvalStr } { }
  309.     private method _insertEntry { beforeEntryPath type name args } { }
  310.     private method _insertCascade { bfIndex tkMenuPath path args } { }
  311.     private method _deleteEntry { args } { }
  312.     private method _configureMenu { path tkPath args } { }
  313.     private method _configureMenuOption { type path args } { }
  314.     private method _configureMenuEntry { path index args } { }
  315.     private method _unsetPaths { parent } { }
  316.     private method _entryPathToTkMenuPath {entryPath} { }
  317.     private method _getTkIndex { tkMenuPath tkIndex} { }
  318.     private method _getPdIndex { tkMenuPath tkIndex } { }
  319.     private method _getMenuList { } { }
  320.     private method _getEntryList { menu } { }
  321.     private method _parsePath { path } { }
  322.     private method _getSymbolicPath { path } { }
  323.     private method _getCallerLevel { }
  324.  
  325.     private variable _parseLevel 0        ;# The parse level depth
  326.     private variable _callerLevel #0      ;# abs level of caller
  327.     private variable _pathMap             ;# Array indexed by Menubar's path
  328.                                           ;# naming, yields tk menu path
  329.     private variable _entryIndex -1       ;# current entry help is displayed
  330.                                           ;# for during help <motion> events
  331.     private variable _options             ;# New options for entry widgets
  332.  
  333.     private variable _tkMenuPath          ;# last tk menu being added to
  334.     private variable _ourMenuPath         ;# our last valid path constructed.
  335. }
  336.  
  337. # ------------------------------------------------------------------
  338. #                           CONSTRUCTOR
  339. # ------------------------------------------------------------------
  340. body iwidgets::Menubar::constructor { args } {
  341.  
  342.     #
  343.     # Create the Menubar Frame that will hold the menus.
  344.     #
  345.     # might want to make -relief and -bd options with defaults
  346.     itk_component add menubar {
  347.         frame $itk_interior.menubar -relief raised -bd 2
  348.     } {
  349.         keep -cursor -background -width -height
  350.     }
  351.     pack $itk_component(menubar) -fill both -expand yes
  352.  
  353.     # Map our pathname to class to the actual menubar frame
  354.     set _pathMap(.) $itk_component(menubar)
  355.  
  356.     eval itk_initialize $args
  357.  
  358.     #
  359.     # HACK HACK HACK
  360.     # Tk expects some variables to be defined and due to some
  361.     # unknown reason we confuse its normal ordering. So, if
  362.     # the user creates a menubutton with no menu it will fail
  363.     # when clicked on with a "Error: can't read $tkPriv(oldGrab):
  364.     # no such element in array". So by setting it to null we
  365.     # avoid this error.
  366.     uplevel #0 "set tkPriv(oldGrab) {}"
  367.  
  368. }
  369.  
  370. #
  371. # Provide a lowercase access method for the Tabset class
  372. #
  373. proc ::iwidgets::menubar { args } {
  374.     uplevel ::iwidgets::Menubar $args
  375. }
  376.  
  377.  
  378. # ------------------------------------------------------------------
  379. #                           OPTIONS
  380. # ------------------------------------------------------------------
  381. # This first set of options are for configuring menus and/or menubuttons
  382. # at the menu level.
  383. #
  384. # ------------------------------------------------------------------
  385. # OPTION -foreground
  386. #
  387. # menu
  388. # menubutton
  389. # ------------------------------------------------------------------
  390. configbody iwidgets::Menubar::foreground {
  391. }
  392.  
  393. # ------------------------------------------------------------------
  394. # OPTION -activebackground
  395. #
  396. # menu
  397. # menubutton
  398. # ------------------------------------------------------------------
  399. configbody iwidgets::Menubar::activebackground {
  400. }
  401.  
  402. # ------------------------------------------------------------------
  403. # OPTION -activeborderwidth
  404. #
  405. # menu
  406. # ------------------------------------------------------------------
  407. configbody iwidgets::Menubar::activeborderwidth {
  408. }
  409.  
  410. # ------------------------------------------------------------------
  411. # OPTION -activeforeground
  412. #
  413. # menu
  414. # menubutton
  415. # ------------------------------------------------------------------
  416. configbody iwidgets::Menubar::activeforeground {
  417. }
  418.  
  419. # ------------------------------------------------------------------
  420. # OPTION -anchor
  421. #
  422. # menubutton
  423. # ------------------------------------------------------------------
  424. configbody iwidgets::Menubar::anchor {
  425. }
  426.  
  427. # ------------------------------------------------------------------
  428. # OPTION -borderwidth
  429. #
  430. # menu
  431. # menubutton
  432. # ------------------------------------------------------------------
  433. configbody iwidgets::Menubar::borderwidth {
  434. }
  435.  
  436. # ------------------------------------------------------------------
  437. # OPTION -disabledforeground
  438. #
  439. # menu
  440. # menubutton
  441. # ------------------------------------------------------------------
  442. configbody iwidgets::Menubar::disabledforeground {
  443. }
  444.  
  445. # ------------------------------------------------------------------
  446. # OPTION -font
  447. #
  448. # menu
  449. # menubutton
  450. # ------------------------------------------------------------------
  451. configbody iwidgets::Menubar::font {
  452. }
  453.  
  454. # ------------------------------------------------------------------
  455. # OPTION -highlightbackground
  456. #
  457. # menubutton
  458. # ------------------------------------------------------------------
  459. configbody iwidgets::Menubar::highlightbackground {
  460. }
  461.  
  462. # ------------------------------------------------------------------
  463. # OPTION -highlightcolor
  464. #
  465. # menubutton
  466. # ------------------------------------------------------------------
  467. configbody iwidgets::Menubar::highlightcolor {
  468. }
  469.  
  470. # ------------------------------------------------------------------
  471. # OPTION -highlightthickness
  472. #
  473. # menubutton
  474. # ------------------------------------------------------------------
  475. configbody iwidgets::Menubar::highlightthickness {
  476. }
  477.  
  478. # ------------------------------------------------------------------
  479. # OPTION -justify
  480. #
  481. # menubutton
  482. # ------------------------------------------------------------------
  483. configbody iwidgets::Menubar::justify {
  484. }
  485.  
  486. # ------------------------------------------------------------------
  487. # OPTION -padx
  488. #
  489. # menubutton
  490. # ------------------------------------------------------------------
  491. configbody iwidgets::Menubar::padx {
  492. }
  493.  
  494. # ------------------------------------------------------------------
  495. # OPTION -pady
  496. #
  497. # menubutton
  498. # ------------------------------------------------------------------
  499. configbody iwidgets::Menubar::pady {
  500. }
  501.  
  502. # ------------------------------------------------------------------
  503. # OPTION -wraplength
  504. #
  505. # menubutton
  506. # ------------------------------------------------------------------
  507. configbody iwidgets::Menubar::wraplength {
  508. }
  509.  
  510. # ------------------------------------------------------------------
  511. # OPTION -menubuttons
  512. #
  513. # The menuButton option is a string which specifies the arrangement 
  514. # of menubuttons on the Menubar frame. Each menubutton entry is 
  515. # delimited by the newline character. Each entry is treated as 
  516. # an add command to the Menubar. 
  517. #
  518. # ------------------------------------------------------------------
  519. configbody iwidgets::Menubar::menubuttons {
  520.     if { $itk_option(-menubuttons) != {} } {
  521.  
  522.         # IF one exists already, delete the old one and create
  523.         # a new one
  524.         if { ! [catch {_parsePath .0}] } {
  525.             delete .0 .last
  526.         } 
  527.  
  528.         #
  529.         # Determine the context level to evaluate the option string at
  530.         #
  531.         set _callerLevel [_getCallerLevel]
  532.  
  533.         #
  534.         # Parse the option string in their scope, then execute it in
  535.         # our scope.
  536.         #
  537.         incr _parseLevel
  538.         _substEvalStr itk_option(-menubuttons)
  539.         eval $itk_option(-menubuttons)
  540.  
  541.         # reset so that we know we aren't parsing in a scope currently.
  542.         incr _parseLevel -1
  543.     }
  544. }
  545.  
  546. # ------------------------------------------------------------------
  547. # OPTION -helpvariable
  548. #
  549. # Specifies the global variable to update whenever the mouse is in 
  550. # motion over a menu entry. This global variable is updated with the 
  551. # current value of the active menu entry's helpStr. Other widgets 
  552. # can "watch" this variable with the trace command, or as is the 
  553. # case with entry or label widgets, they can set their textVariable 
  554. # to the same global variable. This allows for a simple implementation 
  555. # of a help status bar. Whenever the mouse leaves a menu entry, 
  556. # the helpVariable is set to the empty string {}.
  557. #
  558. # ------------------------------------------------------------------
  559. configbody iwidgets::Menubar::helpvariable {
  560.     if {"" != $itk_option(-helpvariable) &&
  561.         ![string match ::* $itk_option(-helpvariable)]} {
  562.         set itk_option(-helpvariable) "::$itk_option(-helpvariable)"
  563.     }
  564. }
  565.  
  566.  
  567. # -------------------------------------------------------------
  568. #
  569. # METHOD: add type path args
  570. #
  571. # Adds either a menu to the menu bar or a menu entry to a
  572. # menu pane.
  573. #
  574. # If the type is one of  cascade,  checkbutton,  command,
  575. # radiobutton,  or separator it adds a new entry to the bottom
  576. # of the menu denoted by the menuPath prefix of componentPath-
  577. # Name.  The  new entry's type is given by type. If additional
  578. # arguments are present, they  specify  options  available  to
  579. # component  type  Entry. See the man pages for menu(n) in the
  580. # section on Entries. In addition all entries accept an  added
  581. # option, helpStr:
  582. #
  583. #     -helpstr value
  584. #
  585. # Specifes the string to associate with  the  entry.
  586. # When the mouse moves over the associated entry, the variable
  587. # denoted by helpVariable is set. Another widget can  bind  to
  588. # the helpVariable and thus display status help.
  589. #
  590. # If the type is menubutton, it adds a new  menubut-
  591. # ton  to  the  menu bar. If additional arguments are present,
  592. # they specify options available to component type MenuButton.
  593. #
  594. # If the type is menubutton  or  cascade,  the  menu
  595. # option  is  available  in  addition to normal Tk options for
  596. # these to types.
  597. #
  598. #      -menu menuSpec
  599. #
  600. # This is only valid for componentPathNames of  type
  601. # menubutton  or  cascade. Specifes an option set and/or a set
  602. # of entries to place on a menu and associate with  the  menu-
  603. # button or cascade. The option keyword allows the menu widget
  604. # to be configured. Each item in the menuSpec  is  treated  as
  605. # add  commands  (each  with  the  possibility of having other
  606. # -menu options). In this way a menu can be recursively built.
  607. #
  608. # The last segment of  componentPathName  cannot  be
  609. # one  of  the  keywords last, menu, end. Additionally, it may
  610. # not be a number. However the componentPathName may be refer-
  611. # enced  in  this  manner  (see  discussion  of Component Path
  612. # Names).
  613. #
  614. # -------------------------------------------------------------
  615. body iwidgets::Menubar::add { type path args } {
  616.  
  617.     if { $type != "menubutton" && \
  618.          $type != "command" && \
  619.          $type != "cascade" && \
  620.          $type != "separator" && \
  621.          $type != "radiobutton" && \
  622.          $type != "checkbutton" } {
  623.         error "bad type \"$type\": must be one of the following:\
  624.                 \"command\", \"checkbutton\", \"radiobutton\",\
  625.                 \"separator\", \"cascacde\", or \"menubutton\""
  626.     }
  627.  
  628.     regsub {.*[.]} $path "" segName
  629.     if { $segName == "menu" || $segName == "last" || $segName == "end" || \
  630.                 [regexp {^[0-9]+$} $segName] } {
  631.         error "bad name \"$segName\": user created component \
  632.                 path names may not end with \
  633.                 \"end\", \"last\", \"menu\", \
  634.                 or be an integer"
  635.     }
  636.  
  637.     # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
  638.     # OK, either add a menu
  639.     # '''''''''''''''''''''''''''''''''''''''''''''''''''''
  640.     if { $type == "menubutton" } {
  641.         # grab the last component name (the menu name)
  642.         return [eval "_addMenuButton $segName $args"]
  643.     # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
  644.     # Or add an entry
  645.     # '''''''''''''''''''''''''''''''''''''''''''''''''''''
  646.     } else {
  647.         return [eval _addEntry $type $path $args]
  648.     }
  649. }
  650.  
  651.  
  652.     
  653. # -------------------------------------------------------------
  654. #
  655. # METHOD: delete entryPath ?entryPath2?
  656. #
  657. # If componentPathName is of component type MenuButton or
  658. # Menu,  delete  operates  on menus. If componentPathName is of
  659. # component type Entry, delete operates on menu entries.
  660. #
  661. # This  command  deletes  all  components  between   com-
  662. # ponentPathName  and  componentPathName2  inclusive.  If com-
  663. # ponentPathName2  is  omitted  then  it  defaults   to   com-
  664. # ponentPathName. Returns an empty string.
  665. #
  666. # If componentPathName is of type Menubar, then all menus
  667. # and  the menu bar frame will be destroyed. In this case com-
  668. # ponentPathName2 is ignored.
  669. #
  670. # -------------------------------------------------------------
  671. body iwidgets::Menubar::delete { args } {
  672.  
  673.     # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
  674.     # Handle out of bounds in arg lengths
  675.     # '''''''''''''''''''''''''''''''''''''''''''''''''''''
  676.     if { [llength $args] > 0 && [llength $args] <=2 } {
  677.  
  678.         # Path Conversions
  679.         # '''''''''''''''''''''''''''''''''''''''''''''''''''''
  680.         set path [_parsePath [lindex $args 0]]
  681.  
  682.         set pathOrIndex $_pathMap($path)
  683.  
  684.         # Menu Entry
  685.         # '''''''''''''''''''''''''''''''''''''''''''''''''''''
  686.         if { [regexp {^[0-9]+$} $pathOrIndex] } {
  687.             eval "_deleteEntry $args"
  688.  
  689.         # Menu
  690.         # '''''''''''''''''''''''''''''''''''''''''''''''''''''
  691.         } else {
  692.             eval "_deleteMenu $args"
  693.         }
  694.     } else {
  695.         error "wrong # args: should be \
  696.                 \"$itk_component(hull) delete pathName ?pathName2?\""
  697.     }
  698. return ""
  699. }
  700.  
  701. # -------------------------------------------------------------
  702. #
  703. # METHOD: index path
  704. #
  705. # If componentPathName is of type menubutton or menu,  it
  706. # returns  the  position of the menu/menubutton on the Menubar
  707. # frame.
  708. #
  709. # If componentPathName is  of  type  command,  separator,
  710. # radiobutton,  checkbutton,  or  cascade, it returns the menu
  711. # widget's numerical index for the entry corresponding to com-
  712. # ponentPathName. If path is not found or the Menubar frame is
  713. # passed in, -1 is returned.
  714. #
  715. # -------------------------------------------------------------
  716. body iwidgets::Menubar::index { path } {
  717.  
  718.     # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
  719.     # Path conversions
  720.     # '''''''''''''''''''''''''''''''''''''''''''''''''''''
  721.     if { [catch {set fullPath [_parsePath $path]} ] } {
  722.         return -1
  723.     }
  724.     if { [catch {set tkPathOrIndex $_pathMap($fullPath)} ] } {
  725.         return -1
  726.     }
  727.  
  728.     # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
  729.     # If integer, return the value, otherwise look up the menu position
  730.     # '''''''''''''''''''''''''''''''''''''''''''''''''''''
  731.     if { [regexp {^[0-9]+$} $tkPathOrIndex] } {
  732.         set index $tkPathOrIndex
  733.     } else {
  734.         set index [lsearch [_getMenuList] $fullPath]
  735.     }
  736.  
  737.     return $index
  738. }
  739.     
  740. # -------------------------------------------------------------
  741. #
  742. # METHOD: insert beforeComponent type name ?option value?
  743. #
  744. # Insert a new component named name before the  component
  745. # specified by componentPathName.
  746. #
  747. # If componentPathName is of type MenuButton or Menu, the
  748. # new  component  inserted  is of type Menu and given the name
  749. # name. In this  case  valid  option  value  pairs  are  those
  750. # accepted by menubuttons.
  751. #
  752. # If componentPathName is of type  Entry,  the  new  com-
  753. # ponent inserted is of type Entry and given the name name. In
  754. # this case valid option value pairs  are  those  accepted  by
  755. # menu entries.
  756. #
  757. # name cannot be one of the  keywords  last,  menu,  end.
  758. # dditionally,  it  may  not  be  a  number. However the com-
  759. # ponentPathName may be referenced in this manner (see discus-
  760. # sion of Component Path Names).
  761. #
  762. # Returns -1 if the menubar frame is passed in.
  763. #
  764. # -------------------------------------------------------------
  765. body iwidgets::Menubar::insert { beforeComponent type name args } {
  766.  
  767.     if { $type != "menubutton" && \
  768.          $type != "command" && \
  769.          $type != "cascade" && \
  770.          $type != "separator" && \
  771.          $type != "radiobutton" && \
  772.          $type != "checkbutton" } {
  773.         error "bad type \"$type\": must be one of the following:\
  774.                 \"command\", \"checkbutton\", \"radiobutton\",\
  775.                 \"separator\", \"cascacde\", or \"menubutton\""
  776.     }
  777.  
  778.     if { $name == "menu" || $name == "last" || $name == "end" || \
  779.                 [regexp {^[0-9]+$} $name] } {
  780.         error "bad name \"$name\": user created component \
  781.                 path names may not end with \
  782.                 \"end\", \"last\", \"menu\", \
  783.                 or be an integer"
  784.     }
  785.  
  786.     set beforeComponent [_parsePath $beforeComponent]
  787.  
  788.     # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
  789.     # Choose menu insertion or entry insertion
  790.     # '''''''''''''''''''''''''''''''''''''''''''''''''''''
  791.     if { $type == "menubutton" } {
  792.         return [eval _insertMenuButton $beforeComponent $name $args]
  793.     } else {
  794.         return [eval _insertEntry $beforeComponent $type $name $args]
  795.     }
  796. }
  797.  
  798.  
  799. # -------------------------------------------------------------
  800. #
  801. # METHOD: invoke entryPath
  802. #
  803. # Invoke  the  action  of  the  menu  entry  denoted   by
  804. # entryComponentPathName.  See  the sections on the individual
  805. # entries in the menu(n) man pages. If the menu entry is  dis-
  806. # abled  then  nothing  happens.  If  the  entry has a command
  807. # associated with it  then  the  result  of  that  command  is
  808. # returned  as the result of the invoke widget command. Other-
  809. # wise the result is an empty string.
  810. #
  811. # If componentPathName is not a menu entry, an  error  is
  812. # issued.
  813. #
  814. # -------------------------------------------------------------
  815. body iwidgets::Menubar::invoke { entryPath } {
  816.  
  817.     # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
  818.     # Path Conversions
  819.     # '''''''''''''''''''''''''''''''''''''''''''''''''''''
  820.     set entryPath [_parsePath $entryPath]
  821.     set index $_pathMap($entryPath)
  822.  
  823.     # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
  824.     # Error Processing
  825.     # '''''''''''''''''''''''''''''''''''''''''''''''''''''
  826.     # first verify that beforeEntryPath is actually a path to
  827.     # an entry and not to menu, menubutton, etc.
  828.     if { ! [regexp {^[0-9]+$} $index] } {
  829.         error "bad entry path: beforeEntryPath is not an entry"
  830.     }
  831.  
  832.     # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
  833.     # Call invoke command
  834.     # '''''''''''''''''''''''''''''''''''''''''''''''''''''
  835.     # get the tk menu path to call
  836.     set tkMenuPath [_entryPathToTkMenuPath $entryPath]
  837.  
  838.     # call the menu's invoke command, adjusting index based on tearoff
  839.     $tkMenuPath invoke [_getTkIndex $tkMenuPath $index]
  840. }
  841.  
  842. # -------------------------------------------------------------
  843. #
  844. # METHOD: menucget componentPath option
  845. #
  846. # Returns the current value of the  configuration  option
  847. # given  by  option.  The  component type of componentPathName
  848. # determines the valid available options.
  849. #
  850. # -------------------------------------------------------------
  851. body iwidgets::Menubar::menucget { args } {
  852.  
  853.     return [lindex [eval menuconfigure $args] 4]
  854.  
  855. }
  856.     
  857. # -------------------------------------------------------------
  858. #
  859. # METHOD: menuconfigure componentPath ?option? ?value option value...?
  860. #
  861. # Query or modify the configuration options of  the  sub-
  862. # component  of the Menubar specified by componentPathName. If
  863. # no option is specified, returns a list describing all of the
  864. # available     options     for     componentPathName     (see
  865. # Tk_ConfigureInfo for  information  on  the  format  of  this
  866. # list).  If  option is specified with no value, then the com-
  867. # mand returns a list describing the one  named  option  (this
  868. # list  will  be identical to the corresponding sublist of the
  869. # value returned if no option is specified). If  one  or  more
  870. # option-value  pairs are specified, then the command modifies
  871. # the given widget option(s) to have the  given  value(s);  in
  872. # this case the command returns an empty string. The component
  873. # type of componentPathName  determines  the  valid  available
  874. # options.
  875. #
  876. # -------------------------------------------------------------
  877. body iwidgets::Menubar::menuconfigure { path args } {
  878.  
  879.     # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
  880.     # Path Conversions
  881.     # '''''''''''''''''''''''''''''''''''''''''''''''''''''
  882.     set path [_parsePath $path]
  883.     set tkPathOrIndex $_pathMap($path)
  884.  
  885.     # Case: Menu entry being configured
  886.     # '''''''''''''''''''''''''''''''''''''''''''''''''''''
  887.     if { [regexp {^[0-9]+$} $tkPathOrIndex] } {
  888.         return [eval "_configureMenuEntry $path $tkPathOrIndex $args"]
  889.  
  890.     # Case: Menu (button and pane) being configured.
  891.     # '''''''''''''''''''''''''''''''''''''''''''''''''''''
  892.     } else {
  893.         set result [eval _configureMenu $path $tkPathOrIndex $args]
  894.         return $result
  895.  
  896.  
  897.     }
  898.  
  899. }
  900. # -------------------------------------------------------------
  901. #
  902. # METHOD: path
  903. #
  904. # SYNOPIS: path ?<mode>? <pattern>
  905. #
  906. # Returns a fully formed component path that matches pat-
  907. # tern.  If no match is found it returns -1. The mode argument
  908. # indicates how the search is to be  matched  against  pattern
  909. # and it must have one of the following values:
  910. #
  911. #     -glob     Pattern is a glob-style pattern which is
  912. #       matched  against each component path using the same rules as
  913. #       the string match command.
  914. #
  915. #     -regexp   Pattern is treated as a regular  expression  
  916. #       and matched against each component path using the same
  917. #       rules as the regexp command.
  918. #
  919. # The default mode is -glob.
  920. #
  921. # -------------------------------------------------------------
  922. body iwidgets::Menubar::path { args } {
  923.  
  924.     set len [llength $args]
  925.     if { $len < 1 || $len > 2 } {
  926.         error "wrong # args: should be \
  927.                 \"$itk_component(hull) path ?mode?> <pattern>\""
  928.     }
  929.  
  930.     set pathList [array names _pathMap]
  931.  
  932.     set len [llength $args]
  933.     switch -- $len {
  934.         1 {
  935.             # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
  936.             # Case: no search modes given
  937.             # '''''''''''''''''''''''''''''''''''''''''''''''''''''
  938.             set pattern [lindex $args 0]
  939.             set found [lindex $pathList [lsearch -glob $pathList $pattern]]
  940.         } 
  941.         2 {
  942.             # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
  943.             # Case: search modes present (-glob, -regexp)
  944.             # '''''''''''''''''''''''''''''''''''''''''''''''''''''
  945.             set options [lindex $args 0]
  946.             set pattern [lindex $args 1]
  947.             set found \
  948.                 [lindex $pathList [lsearch $options $pathList $pattern]]
  949.         }
  950.         default {
  951.             # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
  952.             # Case: wrong # arguments
  953.             # '''''''''''''''''''''''''''''''''''''''''''''''''''''
  954.             error "wrong # args: \
  955.                 should be \"$itk_component(hull) path ?-glob? ?-regexp? pattern\""
  956.         }
  957.     }
  958.  
  959.     return $found
  960. }
  961.  
  962. # -------------------------------------------------------------
  963. #
  964. # METHOD: type path
  965. #
  966. # Returns the type of the component  given  by  entryCom-
  967. # ponentPathName.  For menu entries, this is the type argument
  968. # passed to the add/insert widget command when the  entry  was
  969. # created, such as command or separator. Othewise it is either
  970. # a menubutton or a menu.
  971. #
  972. # -------------------------------------------------------------
  973. body iwidgets::Menubar::type { path } {
  974.  
  975.     # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
  976.     # Path Conversions
  977.     # '''''''''''''''''''''''''''''''''''''''''''''''''''''
  978.     set path [_parsePath $path]
  979.  
  980.     # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
  981.     # Error Handling: does the path exist?
  982.     # '''''''''''''''''''''''''''''''''''''''''''''''''''''
  983.     if { [catch {set index $_pathMap($path)} ] } {
  984.         error "bad path \"$path\""
  985.     }
  986.  
  987.     # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
  988.     # ENTRY, Ask TK for type
  989.     # '''''''''''''''''''''''''''''''''''''''''''''''''''''
  990.     if { [regexp {^[0-9]+$} $index] } {
  991.         # get the menu path from the entry path name
  992.         set tkMenuPath [_entryPathToTkMenuPath $path]
  993.  
  994.         # call the menu's type command, adjusting index based on tearoff
  995.         set type [$tkMenuPath type [_getTkIndex $tkMenuPath $index]]
  996.     # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
  997.     # MENUBUTTON, MENU, or FRAME
  998.     # '''''''''''''''''''''''''''''''''''''''''''''''''''''
  999.     } else {
  1000.         # should not happen, but have a path that is not a valid window.
  1001.         if { [catch {set className [winfo class $_pathMap($path)]}] } {
  1002.             error "serious error: \"$path\" is not a valid window"
  1003.         }
  1004.         # get the classname, look it up, get index, us it to look up type
  1005.         set type [ lindex \
  1006.                     {frame menubutton menu} \
  1007.                     [lsearch { Frame Menubutton Menu } $className] \
  1008.                  ]
  1009.     }
  1010.     return $type
  1011. }
  1012.  
  1013. # -------------------------------------------------------------
  1014. #
  1015. # METHOD: yposition entryPath
  1016. #
  1017. # Returns a decimal string giving the y-coordinate within
  1018. # the  menu window of the topmost pixel in the entry specified
  1019. # by componentPathName. If the  componentPathName  is  not  an
  1020. # entry, an error is issued.
  1021. #
  1022. # -------------------------------------------------------------
  1023. body iwidgets::Menubar::yposition { entryPath } {
  1024.  
  1025.     # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
  1026.     # Path Conversions
  1027.     # '''''''''''''''''''''''''''''''''''''''''''''''''''''
  1028.     set entryPath [_parsePath $entryPath]
  1029.     set index $_pathMap($entryPath)
  1030.  
  1031.     # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
  1032.     # Error Handling
  1033.     # '''''''''''''''''''''''''''''''''''''''''''''''''''''
  1034.     # first verify that entryPath is actually a path to
  1035.     # an entry and not to menu, menubutton, etc.
  1036.     if { ! [regexp {^[0-9]+$} $index] } {
  1037.         error "bad value: entryPath is not an entry"
  1038.     }
  1039.  
  1040.     # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
  1041.     # Call yposition command
  1042.     # '''''''''''''''''''''''''''''''''''''''''''''''''''''
  1043.     # get the menu path from the entry path name
  1044.     set tkMenuPath [_entryPathToTkMenuPath $entryPath]
  1045.  
  1046.     # call the menu's yposition command, adjusting index based on tearoff
  1047.     return [$tkMenuPath yposition [_getTkIndex $tkMenuPath $index]]
  1048.  
  1049. }
  1050.  
  1051. # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1052. # PARSING METHODS
  1053. # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1054. # -------------------------------------------------------------
  1055. #
  1056. # PARSING METHOD: menubutton
  1057. #
  1058. # This method is invoked via an evaluation of the -menubuttons
  1059. # option for the Menubar.
  1060. #
  1061. # It adds a new menubutton and processes any -menu options
  1062. # for creating entries on the menu pane associated with the 
  1063. # menubutton
  1064. # -------------------------------------------------------------
  1065. body iwidgets::Menubar::menubutton { menuName args } {
  1066.     eval "add menubutton .$menuName $args"
  1067. }
  1068.  
  1069. # -------------------------------------------------------------
  1070. #
  1071. # PARSING METHOD: options
  1072. #
  1073. # This method is invoked via an evaluation of the -menu
  1074. # option for menubutton commands.
  1075. #
  1076. # It configures the current menu ($_ourMenuPath) with the options
  1077. # that follow (args)
  1078. #
  1079. # -------------------------------------------------------------
  1080. body iwidgets::Menubar::options { args } {
  1081.     eval "$_tkMenuPath configure $args"
  1082. }
  1083.  
  1084.  
  1085. # -------------------------------------------------------------
  1086. #
  1087. # PARSING METHOD: command
  1088. #
  1089. # This method is invoked via an evaluation of the -menu
  1090. # option for menubutton commands.
  1091. #
  1092. # It adds a new command entry to the current menu, $_ourMenuPath
  1093. # naming it $cmdName.
  1094. #
  1095. # -------------------------------------------------------------
  1096. body iwidgets::Menubar::command { cmdName args } {
  1097.     eval "add command $_ourMenuPath.$cmdName $args"
  1098. }
  1099.  
  1100. # -------------------------------------------------------------
  1101. #
  1102. # PARSING METHOD: checkbutton
  1103. #
  1104. # This method is invoked via an evaluation of the -menu
  1105. # option for menubutton/cascade commands.
  1106. #
  1107. # It adds a new checkbutton entry to the current menu, $_ourMenuPath
  1108. # naming it $chkName.
  1109. #
  1110. # -------------------------------------------------------------
  1111. body iwidgets::Menubar::checkbutton { chkName args } {
  1112.     eval "add checkbutton $_ourMenuPath.$chkName $args"
  1113. }
  1114.  
  1115. # -------------------------------------------------------------
  1116. #
  1117. # PARSING METHOD: radiobutton
  1118. #
  1119. # This method is invoked via an evaluation of the -menu
  1120. # option for menubutton/cascade commands.
  1121. #
  1122. # It adds a new radiobutton entry to the current menu, $_ourMenuPath
  1123. # naming it $radName.
  1124. #
  1125. # -------------------------------------------------------------
  1126. body iwidgets::Menubar::radiobutton { radName args } {
  1127.     eval "add radiobutton $_ourMenuPath.$radName $args"
  1128. }
  1129.  
  1130. # -------------------------------------------------------------
  1131. #
  1132. # PARSING METHOD: separator
  1133. #
  1134. # This method is invoked via an evaluation of the -menu
  1135. # option for menubutton/cascade commands.
  1136. #
  1137. # It adds a new separator entry to the current menu, $_ourMenuPath
  1138. # naming it $sepName.
  1139. #
  1140. # -------------------------------------------------------------
  1141. body iwidgets::Menubar::separator { sepName args } {
  1142.     eval $_tkMenuPath add separator
  1143.     set _pathMap($_ourMenuPath.$sepName) [_getPdIndex $_tkMenuPath end]
  1144. }
  1145.  
  1146. # -------------------------------------------------------------
  1147. #
  1148. # PARSING METHOD: cascade
  1149. #
  1150. # This method is invoked via an evaluation of the -menu
  1151. # option for menubutton/cascade commands.
  1152. #
  1153. # It adds a new cascade entry to the current menu, $_ourMenuPath
  1154. # naming it $casName. It processes the -menu option if present,
  1155. # adding a new menu pane and its associated entries found.
  1156. #
  1157. # -------------------------------------------------------------
  1158. body iwidgets::Menubar::cascade { casName args } {
  1159.     
  1160.     # Save the current menu we are adding to, cascade can change
  1161.     # the current menu through -menu options.
  1162.     set saveOMP $_ourMenuPath
  1163.     set saveTKP $_tkMenuPath
  1164.  
  1165.     eval "add cascade $_ourMenuPath.$casName $args"
  1166.  
  1167.     # Restore the saved menu states so that the next entries of
  1168.     # the -menu/-menubuttons we are processing will be at correct level.
  1169.     set _ourMenuPath $saveOMP
  1170.     set _tkMenuPath $saveTKP
  1171. }
  1172.  
  1173. # ... A P I   S U P P O R T   M E T H O D S...
  1174.  
  1175. # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1176. # MENU ADD, INSERT, DELETE
  1177. # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1178. # -------------------------------------------------------------
  1179. #
  1180. # PRIVATE METHOD: _addMenuButton
  1181. #
  1182. # Makes a new menubutton & associated -menu, pack appended
  1183. #
  1184. # -------------------------------------------------------------
  1185. body iwidgets::Menubar::_addMenuButton { buttonName args} {
  1186.  
  1187.     eval "_makeMenuButton $buttonName $args"
  1188.  
  1189.     #,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
  1190.     # Pack at end, adjust for help buttonName
  1191.     # ''''''''''''''''''''''''''''''''''
  1192.     if { $buttonName == "help" } {
  1193.         pack $itk_component($buttonName) -side right
  1194.     } else {
  1195.         pack $itk_component($buttonName) -side left
  1196.     }
  1197.  
  1198.     return $itk_component($buttonName)
  1199. }
  1200.  
  1201. # -------------------------------------------------------------
  1202. #
  1203. # PRIVATE METHOD: _insertMenuButton
  1204. #
  1205. # inserts a menubutton named $buttonName on a menu bar before 
  1206. # another menubutton specified by $beforeMenuPath
  1207. #
  1208. # -------------------------------------------------------------
  1209. body iwidgets::Menubar::_insertMenuButton { beforeMenuPath buttonName args} {
  1210.  
  1211.     eval "_makeMenuButton $buttonName $args"
  1212.  
  1213.     #,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
  1214.     # Pack before the $beforeMenuPath
  1215.     # ''''''''''''''''''''''''''''''''
  1216.     set beforeTkMenu $_pathMap($beforeMenuPath)
  1217.     regsub {[.]menu$} $beforeTkMenu "" beforeTkMenu
  1218.     pack $itk_component(menubar).$buttonName \
  1219.             -side left \
  1220.             -before $beforeTkMenu
  1221.  
  1222.     return $itk_component($buttonName)
  1223. }
  1224.  
  1225. # -------------------------------------------------------------
  1226. #
  1227. # PRIVATE METHOD: _makeMenuButton
  1228. #
  1229. # creates a menubutton named buttonName on the menubar with args.
  1230. # The -menu option if present will trigger attaching a menu pane.
  1231. #
  1232. # -------------------------------------------------------------
  1233. body iwidgets::Menubar::_makeMenuButton {buttonName args} {
  1234.  
  1235.     set menuEvalStr {}
  1236.  
  1237.     #,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
  1238.     # Capture the -menu option if present
  1239.     # '''''''''''''''''''''''''''''''''''
  1240.     # does the -menu switch exist in the args list??
  1241.     if { [regexp -- {-menu} $args] } {
  1242.         # Make a menu Option
  1243.         set menuOpt [iwidgets::MenuOption #auto]
  1244.  
  1245.         # set the -menu value (if present in args)
  1246.         eval "$menuOpt set $args"
  1247.  
  1248.         set menuEvalStr [$menuOpt cget -value]
  1249.  
  1250.         # add the -menu option to our options list (attach to menu)
  1251.         lappend _options(.$buttonName) $menuOpt
  1252.  
  1253.     }
  1254.  
  1255.     # attach the menu to the menubutton's arg list
  1256.     lappend args -menu $itk_component(menubar).$buttonName.menu
  1257.  
  1258.     #,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
  1259.     # Create menubutton component
  1260.     # ''''''''''''''''''''''''''''''''
  1261.     itk_component add $buttonName {
  1262.         eval ::menubutton \
  1263.                 $itk_component(menubar).$buttonName \
  1264.                 $args 
  1265.     } {
  1266.         keep \
  1267.             -activebackground \
  1268.             -activeforeground \
  1269.             -anchor \
  1270.             -background \
  1271.             -borderwidth \
  1272.             -cursor \
  1273.             -disabledforeground \
  1274.             -font \
  1275.             -foreground \
  1276.             -highlightbackground \
  1277.             -highlightcolor \
  1278.             -highlightthickness \
  1279.             -justify \
  1280.             -padx \
  1281.             -pady \
  1282.             -wraplength
  1283.     }
  1284.  
  1285.     set _pathMap(.$buttonName) $itk_component($buttonName)
  1286.  
  1287.     #,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
  1288.     # Adjust for Help Menus
  1289.     # ''''''''''''''''''''''''''''''''
  1290.     if { $buttonName == "help" } {
  1291.         pack $itk_component($buttonName) -side right
  1292.     } else {
  1293.         pack $itk_component($buttonName) -side left
  1294.     }
  1295.  
  1296.     _makeMenu $buttonName $menuEvalStr
  1297.  
  1298.     return $itk_component($buttonName)
  1299.         
  1300. }
  1301.  
  1302. # -------------------------------------------------------------
  1303. #
  1304. # PRIVATE METHOD: _makeMenu
  1305. #
  1306. # Creates a menu.
  1307. # It then evaluates the $menuEvalStr to create entries on the menu.
  1308. #
  1309. # Assumes the existence of $itk_component($buttonName)
  1310. #
  1311. # -------------------------------------------------------------
  1312. body iwidgets::Menubar::_makeMenu { buttonName menuEvalStr } {
  1313.  
  1314.     #,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
  1315.     # Create menu component
  1316.     # ''''''''''''''''''''''''''''''''
  1317.     itk_component add $buttonName-menu {
  1318.         ::menu $itk_component($buttonName).menu
  1319.     } {
  1320.         keep \
  1321.             -activebackground \
  1322.             -activeborderwidth \
  1323.             -activeforeground \
  1324.             -background \
  1325.             -borderwidth \
  1326.             -cursor \
  1327.             -disabledforeground \
  1328.             -font \
  1329.             -foreground 
  1330.     }
  1331.  
  1332.     set _pathMap(.$buttonName.menu) $itk_component($buttonName-menu)
  1333.  
  1334.     #,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
  1335.     # Attach help handler to this menu
  1336.     # ''''''''''''''''''''''''''''''''
  1337.     #bind $itk_component($buttonName-menu) <Motion> \
  1338.             [code $this _helpHandler $itk_component(hull).$buttonName.menu %y]
  1339.     bind $itk_component($buttonName-menu) <Motion> \
  1340.             [code $this _helpHandler .$buttonName.menu %y]
  1341.     #bind $itk_component($buttonName-menu) <Leave> \
  1342.             "+[code $this _leaveHandler $itk_component(hull).$buttonName.menu]"
  1343.     bind $itk_component($buttonName-menu) <Leave> \
  1344.             "+[code $this _leaveHandler .$buttonName.menu]"
  1345.  
  1346.     #,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
  1347.     # Handle -menu
  1348.     #'''''''''''''''''''''''''''''''''
  1349.     set _ourMenuPath .$buttonName
  1350.     set _tkMenuPath $itk_component($buttonName-menu)
  1351.  
  1352.     #
  1353.     # A zero parseLevel says we are at the top of the parse tree,
  1354.     # so get the context scope level and do a subst for the menuEvalStr.
  1355.     #
  1356.     if { $_parseLevel == 0 } {
  1357.         set _callerLevel [_getCallerLevel]
  1358.         _substEvalStr menuEvalStr
  1359.     }
  1360.  
  1361.     #
  1362.     # bump up the parse level, so if we get called via the 'eval $menuEvalStr'
  1363.     # we know to skip the above steps...
  1364.     #
  1365.     incr _parseLevel
  1366.     eval $menuEvalStr
  1367.  
  1368.     #
  1369.     # leaving, so done with this parse level, so bump it back down 
  1370.     #
  1371.     incr _parseLevel -1
  1372. }
  1373.  
  1374. # -------------------------------------------------------------
  1375. #
  1376. # PRIVATE METHOD: _substEvalStr
  1377. #
  1378. # This performs the substitution and evaluation of $ [], \ found
  1379. # in the -menubutton/-menus options
  1380. #
  1381. # -------------------------------------------------------------
  1382. body iwidgets::Menubar::_substEvalStr { evalStr } {
  1383.     upvar $evalStr evalStrRef
  1384.     set evalStrRef [uplevel $_callerLevel [list subst $evalStrRef]]
  1385. }
  1386.  
  1387.  
  1388. # -------------------------------------------------------------
  1389. #
  1390. # PRIVATE METHOD: _deleteMenu
  1391. #
  1392. # _deleteMenu menuPath ?menuPath2?
  1393. #
  1394. # deletes menuPath or from menuPath to menuPath2
  1395. #
  1396. # Menu paths may be formed in one of two ways
  1397. #    .MENUBAR.menuName  where menuName is the name of the menu
  1398. #    .MENUBAR.menuName.menu  where menuName is the name of the menu
  1399. #
  1400. # The basic rule is '.menu' is not needed.
  1401. # -------------------------------------------------------------
  1402. body iwidgets::Menubar::_deleteMenu { args } {
  1403.  
  1404.     set len [llength $args]
  1405.     switch -- $len {
  1406.         1 {
  1407.             # get a corrected path (subst for number, last, end)
  1408.             set path [_parsePath [lindex $args 0]]
  1409.  
  1410.             _deleteAMenu $path
  1411.         }
  1412.  
  1413.         2 {
  1414.             # gets the list of menus in interface order
  1415.             set menuList [_getMenuList]
  1416.  
  1417.             # ... get the start menu and the last menu ...
  1418.  
  1419.             # get a corrected path (subst for number, last, end)
  1420.             set menuStartPath [_parsePath [lindex $args 0]]
  1421.  
  1422.             regsub {[.]menu$} $menuStartPath "" menuStartPath
  1423.  
  1424.             set menuEndPath [_parsePath [lindex $args 1]]
  1425.  
  1426.             regsub {[.]menu$} $menuEndPath "" menuEndPath
  1427.             
  1428.             # get the menu position (0 based) of the start and end menus.
  1429.             set start [lsearch -exact $menuList $menuStartPath]
  1430.             if { $start == -1 } {
  1431.                 error "bad menu path \"$menuStartPath\": \
  1432.                     should be one of $menuList"
  1433.             }
  1434.             set end [lsearch -exact $menuList $menuEndPath]
  1435.             if { $end == -1 } {
  1436.                 error "bad menu path \"$menuEndPath\": \
  1437.                     should be one of $menuList"
  1438.             }
  1439.  
  1440.             # now create the list from this range of menus
  1441.             set delList [lrange $menuList $start $end]
  1442.  
  1443.             # walk thru them deleting each menu.
  1444.             # this list has no .menu on the end.
  1445.             foreach m $delList {
  1446.                 _deleteAMenu $m.menu
  1447.             }
  1448.         }
  1449.         default {
  1450.         }    
  1451.     }
  1452.  
  1453. }
  1454.  
  1455. # -------------------------------------------------------------
  1456. #
  1457. # PRIVATE METHOD: _deleteAMenu
  1458. #
  1459. # _deleteMenu menuPath 
  1460. #
  1461. # deletes a single Menu (menubutton and menu pane with entries)
  1462. #
  1463. # -------------------------------------------------------------
  1464. body iwidgets::Menubar::_deleteAMenu { path } {
  1465.  
  1466.     # We will normalize the path to not include the '.menu' if
  1467.     # it is on the path already.
  1468.  
  1469.     regsub {[.]menu$} $path "" menuButtonPath
  1470.     regsub {.*[.]} $menuButtonPath "" buttonName
  1471.  
  1472.     # Loop through and destroy any cascades, etc on menu.
  1473.     set entryList [_getEntryList $menuButtonPath]
  1474.     foreach entry $entryList {
  1475.         _deleteEntry $entry
  1476.     }
  1477.  
  1478.     # Delete the menubutton and menu components...
  1479.     destroy $itk_component($buttonName-menu)
  1480.     destroy $itk_component($buttonName)
  1481.  
  1482.     # This is because of some itcl bug that doesn't delete
  1483.     # the component on the destroy in some cases...
  1484.     catch {itk_component delete $buttonName-menu}
  1485.     catch {itk_component delete $buttonName}
  1486.     
  1487.     # unset our paths
  1488.     _unsetPaths $menuButtonPath
  1489.  
  1490. }
  1491.  
  1492. # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1493. # ENTRY ADD, INSERT, DELETE
  1494. # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1495.  
  1496. # -------------------------------------------------------------
  1497. #
  1498. # PRIVATE METHOD: _addEntry
  1499. #
  1500. # Adds an entry to menu.
  1501. #
  1502. # -------------------------------------------------------------
  1503. body iwidgets::Menubar::_addEntry { type path args } {
  1504.  
  1505.     # Error Checking
  1506.     # ''''''''''''''
  1507.     # the path should not end with '.menu'
  1508.     if { [regexp {[.]menu$} $path] } {
  1509.         error "bad entry path: \"$path\". \
  1510.                 The name \"menu\" is reserved for menu panes"
  1511.     }
  1512.  
  1513.     # get the tkMenuPath
  1514.     set tkMenuPath [_entryPathToTkMenuPath $path]
  1515.     if { $tkMenuPath == "" } {
  1516.         error "bad entry path: \"$path\". The menu path prefix is not valid"
  1517.     }
  1518.  
  1519.     # ... Store -helpstr value and strip out -helpstr value from args
  1520.     # create a helpstr option 
  1521.     set hs [iwidgets::HelpStrOption #auto]
  1522.  
  1523.     # set the -value switch from an args list
  1524.     eval "$hs set $args"
  1525.  
  1526.     # add the helpstr option to our options list (attach to entry)
  1527.     lappend _options($path) $hs
  1528.  
  1529.     # Handle CASCADE
  1530.     # ''''''''''''''
  1531.     # if this is a cascade go ahead and add in the menu...
  1532.     if { [string match cascade $type] } {
  1533.         # Catch addCascade errors
  1534.         if { [ catch {eval "_addCascade $tkMenuPath $path $args"} errMsg]} {
  1535.             # delete  $hs: @@ 2.0
  1536.             #delete $hs
  1537.             # remove $hs from _options($path)
  1538.             set lastIndex [expr [llength $_options($path)]-1]
  1539.             lreplace $_options($path) $lastIndex $lastIndex ""
  1540.             error $errMsg
  1541.         }
  1542.     # Handle Non-CASCADE
  1543.     # ''''''''''''''''''
  1544.     } else {
  1545.         # add the entry
  1546.         if { [ catch {eval "$tkMenuPath add $type $args"} errMsg] } {
  1547.             # delete  $hs: @@ 2.0
  1548.             #delete $hs
  1549.             # remove $hs from _options($path)
  1550.             set lastIndex [expr [llength $_options($path)]-1]
  1551.             lreplace $_options($path) $lastIndex $lastIndex ""
  1552.             error $errMsg
  1553.         } else {
  1554.             # update our pathmap
  1555.             set _pathMap($path) [_getPdIndex $tkMenuPath end]
  1556.         }
  1557.     }
  1558.  
  1559.     return $_pathMap($path)
  1560. }
  1561.  
  1562. # -------------------------------------------------------------
  1563. #
  1564. # PRIVATE METHOD: _addCascade
  1565. #
  1566. # Creates a cascade button.  Handles the -menu option
  1567. #
  1568. # -------------------------------------------------------------
  1569. body iwidgets::Menubar::_addCascade { tkMenuPath path args } {
  1570.  
  1571.     set menuEvalStr {}
  1572.  
  1573.     # get the cascade name from our path
  1574.     regsub {.*[.]} $path "" cascadeName
  1575.  
  1576.     #,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
  1577.     # Capture the -menu option if present
  1578.     # '''''''''''''''''''''''''''''''''''
  1579.     # does the -menu switch exist in the args list??
  1580.     if { [regexp -- {-menu} $args] } {
  1581.         # Make a menu Option
  1582.         set menuOpt [iwidgets::MenuOption #auto]
  1583.  
  1584.         # set the -menu value (if present in args)
  1585.         eval "$menuOpt set $args"
  1586.  
  1587.         set menuEvalStr [$menuOpt cget -value]
  1588.  
  1589.         # add the -menu option to our options list (attach to menu)
  1590.         lappend _options($path) $menuOpt
  1591.  
  1592.     }
  1593.  
  1594.     # attach the menu pane
  1595.     lappend args -menu $tkMenuPath.$cascadeName
  1596.  
  1597.     # Catch error on adding cascade (could be bad option list, etc.)
  1598.     if { [ catch {eval "$tkMenuPath add cascade $args"} errMsg ] } {
  1599.         # if we appended $menuOpt, then remove it from _options
  1600.         if { [info exists menuOpt] } {
  1601.             # delete  menuOpt, if it exists. ( @@ fix for 2.0 )
  1602.             #delete $menuOpt
  1603.             set lastIndex [expr [llength $_options($path)]-1]
  1604.             lreplace $_options($path) $lastIndex $lastIndex ""
  1605.         }
  1606.         # signal error (for catching above)
  1607.         error $errMsg
  1608.     }
  1609.  
  1610.     # update our pathmap
  1611.     set _pathMap($path) [_getPdIndex $tkMenuPath end]
  1612.  
  1613.     regsub {[.][^.]*$} $path "" cascadePrefix
  1614.     _makeCascadeMenu $tkMenuPath $cascadePrefix $cascadeName $menuEvalStr
  1615.  
  1616.     #return $itk_component($cascadeName)
  1617.  
  1618. }
  1619.  
  1620. # -------------------------------------------------------------
  1621. #
  1622. # PRIVATE METHOD: _makeCascadeMenu
  1623. #
  1624. # Creates a menu.
  1625. # It then evaluates the $menuEvalStr to create entries on the menu.
  1626. #
  1627. # -------------------------------------------------------------
  1628. body iwidgets::Menubar::_makeCascadeMenu { tkMenuPath parentPath cascadeName menuEvalStr } {
  1629.  
  1630.     #,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
  1631.     # Create menu component
  1632.     # ''''''''''''''''''''''''''''''''
  1633.     itk_component add $cascadeName-menu {
  1634.         ::menu $tkMenuPath.$cascadeName 
  1635.     } {
  1636.         keep \
  1637.             -activebackground \
  1638.             -activeborderwidth \
  1639.             -activeforeground \
  1640.             -background \
  1641.             -borderwidth \
  1642.             -cursor \
  1643.             -disabledforeground \
  1644.             -font \
  1645.             -foreground 
  1646.     }
  1647.  
  1648.     set _pathMap($parentPath.$cascadeName.menu) \
  1649.             $itk_component($cascadeName-menu)
  1650.  
  1651.     #,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
  1652.     # Attach help handler to this menu
  1653.     # ''''''''''''''''''''''''''''''''
  1654.     bind $itk_component($cascadeName-menu) <Motion> \
  1655.             [code $this _helpHandler $parentPath.$cascadeName.menu %y]
  1656.     bind $itk_component($cascadeName-menu) <Leave> \
  1657.             "+[code $this _leaveHandler $parentPath.$cascadeName.menu]"
  1658.  
  1659.     #,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
  1660.     # Handle -menu
  1661.     #'''''''''''''''''''''''''''''''''
  1662.     set _ourMenuPath $parentPath.$cascadeName
  1663.     set _tkMenuPath $itk_component($cascadeName-menu)
  1664.  
  1665.     #
  1666.     # A zero parseLevel says we are at the top of the parse tree,
  1667.     # so get the context scope level and do a subst for the menuEvalStr.
  1668.     #
  1669.     if { $_parseLevel == 0 } {
  1670.         set _callerLevel [_getCallerLevel]
  1671.         _substEvalStr menuEvalStr
  1672.     }
  1673.  
  1674.     #
  1675.     # bump up the parse level, so if we get called via the 'eval $menuEvalStr'
  1676.     # we know to skip the above steps...
  1677.     #
  1678.     incr _parseLevel
  1679.     eval $menuEvalStr
  1680.  
  1681.     #
  1682.     # leaving, so done with this parse level, so bump it back down 
  1683.     #
  1684.     incr _parseLevel -1
  1685. }
  1686.  
  1687. # -------------------------------------------------------------
  1688. #
  1689. # PRIVATE METHOD: _insertEntry
  1690. #
  1691. # inserts an entry on a menu before entry given by beforeEntryPath.
  1692. # The added entry is of type TYPE and its name is NAME. ARGS are
  1693. # passed for customization of the entry.
  1694. #
  1695. # -------------------------------------------------------------
  1696. body iwidgets::Menubar::_insertEntry { beforeEntryPath type name args } {
  1697.  
  1698.     # convert entryPath to an index value
  1699.     set bfIndex $_pathMap($beforeEntryPath)
  1700.  
  1701.     # first verify that beforeEntryPath is actually a path to
  1702.     # an entry and not to menu, menubutton, etc.
  1703.     if { ! [regexp {^[0-9]+$} $bfIndex] } {
  1704.         error "bad entry path: beforeEntryPath is not an entry"
  1705.     }
  1706.  
  1707.     # get the menu path from the entry path name
  1708.     regsub {[.][^.]*$} $beforeEntryPath "" menuPathPrefix
  1709.     set tkMenuPath $_pathMap($menuPathPrefix.menu)
  1710.  
  1711.     # INDEX is zero based at this point.
  1712.  
  1713.     # ENTRIES is a zero based list...
  1714.     set entries [_getEntryList $menuPathPrefix]
  1715.  
  1716.     # 
  1717.     # Adjust the entries after the inserted item, to have
  1718.     # the correct index numbers. Note, we stay zero based 
  1719.     # even though tk flips back and forth depending on tearoffs.
  1720.     #
  1721.     for {set i $bfIndex} {$i < [llength $entries]} {incr i} {
  1722.         # path==entry path in numerical order
  1723.         set path [lindex $entries $i]
  1724.  
  1725.         # add one to each entry after the inserted one.
  1726.         set _pathMap($path) [expr $i + 1]
  1727.     }
  1728.  
  1729.     # ... Store -helpstr value and strip out -helpstr value from args
  1730.     # create a helpstr option 
  1731.     set hs [iwidgets::HelpStrOption #auto]
  1732.  
  1733.     # set the -value switch from an args list
  1734.     eval "$hs set $args"
  1735.  
  1736.     set path $menuPathPrefix.$name
  1737.  
  1738.  
  1739.     # Handle CASCADE
  1740.     # ''''''''''''''
  1741.     # if this is a cascade go ahead and add in the menu...
  1742.     if { [string match cascade $type] } {
  1743.  
  1744.         if { [ catch {eval "_insertCascade \
  1745.                 $bfIndex $tkMenuPath $path $args"} errMsg ]} {
  1746.             for {set i $bfIndex} {$i < [llength $entries]} {incr i} {
  1747.                 # path==entry path in numerical order
  1748.                 set path [lindex $entries $i]
  1749.  
  1750.                 # sub the one we added earlier.
  1751.                 set _pathMap($path) [expr $_pathMap($path) - 1]
  1752.                 # @@ delete $hs
  1753.             }
  1754.             error $errMsg
  1755.         }
  1756.  
  1757.     # Handle Entry
  1758.     # ''''''''''''''
  1759.     } else {
  1760.  
  1761.         # give us a zero or 1-based index based on tear-off menu status
  1762.         # invoke the menu's insert command
  1763.         if { [catch {eval "$tkMenuPath insert \
  1764.                 [_getTkIndex $tkMenuPath $bfIndex] $type $args"} errMsg]} {
  1765.             for {set i $bfIndex} {$i < [llength $entries]} {incr i} {
  1766.                 # path==entry path in numerical order
  1767.                 set path [lindex $entries $i]
  1768.  
  1769.                 # sub the one we added earlier.
  1770.                 set _pathMap($path) [expr $_pathMap($path) - 1]
  1771.                 # @@ delete $hs
  1772.             }
  1773.             error $errMsg
  1774.         }
  1775.         
  1776.  
  1777.         # add the helpstr option to our options list (attach to entry)
  1778.         lappend _options($path) $hs
  1779.  
  1780.         # Insert the new entry path into pathmap giving it an index value
  1781.         set _pathMap($menuPathPrefix.$name) $bfIndex
  1782.     
  1783.     }
  1784.  
  1785.     return [_getTkIndex $tkMenuPath $bfIndex]
  1786. }
  1787.  
  1788. # -------------------------------------------------------------
  1789. #
  1790. # PRIVATE METHOD: _insertCascade
  1791. #
  1792. # Creates a cascade button.  Handles the -menu option
  1793. #
  1794. # -------------------------------------------------------------
  1795. body iwidgets::Menubar::_insertCascade { bfIndex tkMenuPath path args } {
  1796.  
  1797.     set menuEvalStr {}
  1798.  
  1799.     # get the cascade name from our path
  1800.     regsub {.*[.]} $path "" cascadeName
  1801.  
  1802.     #,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
  1803.     # Capture the -menu option if present
  1804.     # '''''''''''''''''''''''''''''''''''
  1805.     # does the -menu switch exist in the args list??
  1806.     if { [regexp -- {-menu} $args] } {
  1807.         # Make a menu Option
  1808.         set menuOpt [iwidgets::MenuOption #auto]
  1809.  
  1810.         # set the -menu value (if present in args)
  1811.         eval "$menuOpt set $args"
  1812.  
  1813.         set menuEvalStr [$menuOpt cget -value]
  1814.  
  1815.         # add the -menu option to our options list (attach to menu)
  1816.         lappend _options($path) $menuOpt
  1817.  
  1818.     }
  1819.  
  1820.     # attach the menu pane
  1821.     lappend args -menu $tkMenuPath.$cascadeName
  1822.  
  1823.     # give us a zero or 1-based index based on tear-off menu status
  1824.     # invoke the menu's insert command
  1825.     eval "$tkMenuPath insert \
  1826.             [_getTkIndex $tkMenuPath $bfIndex] cascade $args"
  1827.     
  1828.     # Insert the new entry path into pathmap giving it an index value
  1829.     set _pathMap($path) $bfIndex
  1830.  
  1831.     regsub {[.][^.]*$} $path "" cascadePrefix
  1832.     _makeCascadeMenu $tkMenuPath $cascadePrefix $cascadeName $menuEvalStr
  1833.  
  1834.     #return $itk_component($cascadeName)
  1835. }
  1836.  
  1837. # -------------------------------------------------------------
  1838. #
  1839. # PRIVATE METHOD: _deleteEntry
  1840. #
  1841. # _deleteEntry entryPath ?entryPath2?
  1842. #
  1843. #   either
  1844. # deletes the entry entryPath
  1845. #   or
  1846. # deletes the entries from entryPath to entryPath2 
  1847. #
  1848. # -------------------------------------------------------------
  1849. body iwidgets::Menubar::_deleteEntry { args } {
  1850.  
  1851.     set len [llength $args]
  1852.     switch $len {
  1853.         1 {
  1854.             # get a corrected path (subst for number, last, end)
  1855.             set path [_parsePath [lindex $args 0]]
  1856.  
  1857.             set entryIndex $_pathMap($path)
  1858.             if { $entryIndex == -1 } {
  1859.                 error "bad value for pathName: \
  1860.                         [lindex $args 0] in call to delet"
  1861.             }
  1862.  
  1863.             # get the type, if cascade, we will want to delete menu
  1864.             set type [type $path]
  1865.  
  1866.             # ... munge up the menu name ...
  1867.  
  1868.             # the tkMenuPath is looked up with the .menu added to lookup
  1869.             # strip off the entry component
  1870.             regsub {[.][^.]*$} $path "" menuPath
  1871.             set tkMenuPath $_pathMap($menuPath.menu)
  1872.  
  1873.             # get the ordered entry list
  1874.             set entries [_getEntryList $menuPath]
  1875.  
  1876.             # ... Fix up path entry indices ...
  1877.  
  1878.             # delete the path from the map
  1879.             unset _pathMap([lindex $entries $entryIndex])
  1880.  
  1881.             # Subtract off 1 for each entry below the deleted one.
  1882.             for {set i [expr $entryIndex + 1]} \
  1883.                             {$i < [llength $entries]} \
  1884.                             {incr i} {
  1885.                 set epath [lindex $entries $i]
  1886.                 incr _pathMap($epath) -1
  1887.             }
  1888.  
  1889.             # ... Delete the menu entry widget ...
  1890.  
  1891.             # delete the menu entry, ajusting index for TK
  1892.             $tkMenuPath delete [_getTkIndex $tkMenuPath $entryIndex]
  1893.  
  1894.             if { $type == "cascade" } {
  1895.                 regsub {.*[.]} $path "" cascadeName
  1896.                 destroy $itk_component($cascadeName-menu)
  1897.  
  1898.                 # This is because of some itcl bug that doesn't delete
  1899.                 # the component on the destroy in some cases...
  1900.                 catch {itk_component delete $cascadeName-menu}
  1901.  
  1902.                 _unsetPaths $path
  1903.             }
  1904.  
  1905.         }
  1906.  
  1907.         2 {
  1908.             # get a corrected path (subst for number, last, end)
  1909.             set path1 [_parsePath [lindex $args 0]]
  1910.             set path2 [_parsePath [lindex $args 1]]
  1911.  
  1912.             set fromEntryIndex $_pathMap($path1)
  1913.             if { $fromEntryIndex == -1 } {
  1914.                 error "bad value for entryPath1: \
  1915.                         [lindex $args 0] in call to delet"
  1916.             }
  1917.             set toEntryIndex $_pathMap($path2)
  1918.             if { $toEntryIndex == -1 } {
  1919.                 error "bad value for entryPath2: \
  1920.                         [lindex $args 1] in call to delet"
  1921.             }
  1922.             # ... munge up the menu name ...
  1923.  
  1924.             # the tkMenuPath is looked up with the .menu added to lookup
  1925.             # strip off the entry component
  1926.             regsub {[.][^.]*$} $path1 "" menuPath
  1927.             set tkMenuPath $_pathMap($menuPath.menu)
  1928.  
  1929.             # get the ordered entry list
  1930.             set entries [_getEntryList $menuPath]
  1931.  
  1932.             # ... Fix up path entry indices ...
  1933.  
  1934.             # delete the range from the pathMap list
  1935.             for {set i $fromEntryIndex} {$i <= $toEntryIndex} {incr i} {
  1936.                 unset _pathMap([lindex $entries $i])
  1937.             }
  1938.  
  1939.             # Subtract off 1 for each entry below the deleted range.
  1940.             # Loop from one below the bottom delete entry to end list
  1941.             for {set i [expr $toEntryIndex + 1]} \
  1942.                     {$i < [llength $entries]} \
  1943.                     {incr i} {
  1944.                 # take this path and sets its index back by size of
  1945.                 # deleted range.
  1946.                 set path [lindex $entries $i]
  1947.                 set _pathMap($path) \
  1948.                     [expr $_pathMap($path) - \
  1949.                     (($toEntryIndex - $fromEntryIndex) + 1)]
  1950.             }
  1951.  
  1952.             # ... Delete the menu entry widget ...
  1953.  
  1954.             # delete the menu entry, ajusting index for TK
  1955.             $tkMenuPath delete \
  1956.                         [_getTkIndex $tkMenuPath $fromEntryIndex] \
  1957.                         [_getTkIndex $tkMenuPath $toEntryIndex]
  1958.  
  1959.         }
  1960.  
  1961.         default {
  1962.             error "wrong # args: should be \
  1963.                     \"$itk_component(hull) delete pathName ?pathName2?\""
  1964.         }
  1965.     }
  1966. }
  1967.  
  1968. # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1969. # CONFIGURATION SUPPORT
  1970. # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1971. # -------------------------------------------------------------
  1972. #
  1973. # PRIVATE METHOD: _configureMenu
  1974. #
  1975. # This configures a menu. A menu is a true tk widget, thus we
  1976. # pass the tkPath variable. This path may point to either a 
  1977. # menu button (does not end with the name 'menu', or a menu
  1978. # which ends with the name 'menu'
  1979. #
  1980. # path : our Menubar path name to this menu button or menu pane.
  1981. #        if we end with the name '.menu' then it is a menu pane.
  1982. # tkPath : the path to the corresponding Tk menubutton or menu.
  1983. # args   : the args for configuration
  1984. #
  1985. # -------------------------------------------------------------
  1986. body iwidgets::Menubar::_configureMenu { path tkPath args } {
  1987.  
  1988.     set class [winfo class $tkPath]
  1989.  
  1990.     set len [llength $args]
  1991.     switch $len {
  1992.         0 {
  1993.             set configList [$tkPath configure]
  1994.  
  1995.             if { ! [catch {set _options($path)} ] } {
  1996.                 foreach option $_options($path) {
  1997.                     lappend configList [$option get]
  1998.                 }
  1999.             }
  2000.  
  2001.             return $configList
  2002.         }
  2003.         1 {
  2004.             # ... a get of one config item
  2005.             if { ! [catch {set _options($path)} ] } {
  2006.                 foreach option $_options($path) {
  2007.                     set val [$option get $args]
  2008.                     if { $val != {} } {
  2009.                         return $val
  2010.                     }
  2011.                 }
  2012.             }
  2013.                     
  2014.             # ... OTHERWISE, let Tk get it.
  2015.             return [eval "$tkPath configure $args"]
  2016.         }
  2017.         default {
  2018.             # If this is a menubutton, and has -menu option, process it
  2019.             if { $class == "Menubutton" && [regexp -- {-menu} $args] } {
  2020.                 eval "_configureMenuOption menubutton $path $args"
  2021.             } else {
  2022.                 eval "$tkPath configure $args"
  2023.             }
  2024.             return ""
  2025.         }
  2026.     }
  2027.  
  2028. }
  2029.  
  2030. # -------------------------------------------------------------
  2031. #
  2032. # PRIVATE METHOD: _configureMenuOption
  2033. #
  2034. # Allows for configuration of the -menu option on
  2035. # menubuttons and cascades
  2036. #
  2037. # find out if we are the last menu, or are before one.
  2038. # delete the old menu.
  2039. # if we are the last, then add us back at the end
  2040. # if we are before another menu, get the beforePath
  2041. #
  2042. # -------------------------------------------------------------
  2043. body iwidgets::Menubar::_configureMenuOption { type path args } {
  2044.  
  2045.     regsub {[.][^.]*$} $path "" pathPrefix
  2046.  
  2047.     if { $type == "menubutton" } {
  2048.         set menuList [_getMenuList]
  2049.         set pos [lsearch $menuList $path]
  2050.         if { $pos == [expr [llength $menuList] - 1] } {
  2051.             set insert false
  2052.         } else {
  2053.             set insert true
  2054.         }
  2055.     } elseif { $type == "cascade" } {
  2056.         set lastEntryPath [_parsePath $pathPrefix.last]
  2057.         if { $lastEntryPath == $path } {
  2058.             set insert false
  2059.         } else {
  2060.             set insert true
  2061.         }
  2062.         set pos [index $path]
  2063.  
  2064.     }
  2065.  
  2066.  
  2067.     eval "delete $pathPrefix.$pos"
  2068.     if { $insert } {
  2069.         # get name from path...
  2070.         regsub {.*[.]} $path "" name
  2071.  
  2072.         eval "insert $pathPrefix.$pos $type \
  2073.             $name $args"
  2074.     } else {
  2075.         eval "add $type $path $args"
  2076.     }
  2077. }
  2078.  
  2079. # -------------------------------------------------------------
  2080. #
  2081. # PRIVATE METHOD: _configureMenuEntry
  2082. #
  2083. # This configures a menu entry. A menu entry is either a command,
  2084. # radiobutton, separator, checkbutton, or a cascade. These have
  2085. # a corresponding Tk index value for the corresponding tk menu
  2086. # path.
  2087. #
  2088. # path   : our Menubar path name to this menu entry.
  2089. # index  : the t
  2090. # args   : the args for configuration
  2091. #
  2092. # -------------------------------------------------------------
  2093. body iwidgets::Menubar::_configureMenuEntry { path index args } {
  2094.  
  2095.     set type [type $path]
  2096.  
  2097.     set len [llength $args]
  2098.  
  2099.     # get the menu path from the entry path name
  2100.     set tkMenuPath [_entryPathToTkMenuPath $path]
  2101.  
  2102.     switch $len {
  2103.         0 {
  2104.             set configList [$tkMenuPath entryconfigure \
  2105.                     [_getTkIndex $tkMenuPath $index]]
  2106.  
  2107.             if { ! [catch {set _options($path)} ] } {
  2108.                 foreach option $_options($path) {
  2109.                     lappend configList [$option get]
  2110.                 }
  2111.             }
  2112.  
  2113.             return $configList
  2114.         }
  2115.         1 {
  2116.             # ... a get of one config item
  2117.             if { ! [catch {set _options($path)} ] } {
  2118.                 foreach option $_options($path) {
  2119.                     set val [$option get $args]
  2120.                     if { $val != {} } {
  2121.                         return $val
  2122.                     }
  2123.                 }
  2124.             }
  2125.                     
  2126.             # ... OTHERWISE, let Tk get it.
  2127.             return [eval $tkMenuPath entryconfigure \
  2128.                     [_getTkIndex $tkMenuPath $index] $args]
  2129.         }
  2130.         default {
  2131.             # ... Store -helpstr val,strip out -helpstr val from args
  2132.  
  2133.             # list of options for this widget
  2134.             foreach option $_options($path) {
  2135.                 if { [$option cget -switch] == "-helpstr" } {
  2136.                     eval "$option set $args"
  2137.                 }
  2138.             }
  2139.  
  2140.             if { $type == "cascade" && [regexp -- {-menu} $args] } {
  2141.                 eval "_configureMenuOption cascade $path $args"
  2142.             } else {
  2143.                 # invoke the menu's entryconfigure command
  2144.                 # being careful to ajust the INDEX to be 0 or 1 based 
  2145.                 # depending on the tearoff status
  2146.                 # if the stripping process brought us down to no options
  2147.                 # to set, then forget the configure of widget.
  2148.                 if { [llength $args] != 0 } {
  2149.                     eval "$tkMenuPath entryconfigure \
  2150.                                 [_getTkIndex $tkMenuPath $index] $args"
  2151.                 }
  2152.             }
  2153.             return ""
  2154.  
  2155.         }
  2156.     }
  2157. }
  2158.  
  2159. # -------------------------------------------------------------
  2160. #
  2161. # PRIVATE METHOD: _unsetPaths
  2162. #
  2163. # comment
  2164. #
  2165. # -------------------------------------------------------------
  2166. body iwidgets::Menubar::_unsetPaths { parent } {
  2167.  
  2168.     # first get the complete list of all menu paths
  2169.     set pathList [array names _pathMap]
  2170.  
  2171.     # for each path that matches parent prefix, unset it.
  2172.     foreach path $pathList {
  2173.         if { [regexp [subst -nocommands {^$parent}] $path] } {
  2174.             unset _pathMap($path)
  2175.         }
  2176.     }
  2177. }
  2178.     
  2179. # -------------------------------------------------------------
  2180. #
  2181. # PRIVATE METHOD: _entryPathToTkMenuPath
  2182. #
  2183. # Takes an entry path like .mbar.file.new and changes it to
  2184. # .mbar.file.menu and performs a lookup in the pathMap to
  2185. # get the corresponding menu widget name for tk
  2186. #
  2187. # -------------------------------------------------------------
  2188. body iwidgets::Menubar::_entryPathToTkMenuPath {entryPath} {
  2189.  
  2190.     # get the menu path from the entry path name
  2191.     # by stripping off the entry component of the path
  2192.     regsub {[.][^.]*$} $entryPath "" menuPath
  2193.  
  2194.     # the tkMenuPath is looked up with the .menu added to lookup
  2195.     if { [catch {set tkMenuPath $_pathMap($menuPath.menu)}] } {
  2196.         return ""
  2197.     } else {
  2198.         return $_pathMap($menuPath.menu)
  2199.     }
  2200. }
  2201.  
  2202.  
  2203. # -------------------------------------------------------------
  2204. #
  2205. # These two methods address the issue of menu entry indices being
  2206. # zero-based when the menu is not a tearoff menu and 1-based when
  2207. # it is a tearoff menu. Our strategy is to hide this difference.
  2208. # 
  2209. # _getTkIndex returns the index as tk likes it: 0 based for non-tearoff
  2210. # and 1 based for tearoff menus.
  2211. # 
  2212. # _getPdIndex (get pulldown index) always returns it as 0 based.
  2213. # 
  2214. # -------------------------------------------------------------
  2215.  
  2216. # -------------------------------------------------------------
  2217. # 
  2218. # PRIVATE METHOD: _getTkIndex
  2219. #
  2220. # give us a zero or 1-based answer depending on the tearoff
  2221. # status of the menu. If the menu denoted by tkMenuPath is a
  2222. # tearoff menu it returns a 1-based result, otherwise a 
  2223. # zero-based result.
  2224. # 
  2225. # -------------------------------------------------------------
  2226. body iwidgets::Menubar::_getTkIndex { tkMenuPath tkIndex} {
  2227.  
  2228.     # if there is a tear off make it 1-based index
  2229.     if { [$tkMenuPath cget -tearoff] } {
  2230.         incr tkIndex
  2231.     }
  2232.  
  2233.     return $tkIndex
  2234. }
  2235.     
  2236. # -------------------------------------------------------------
  2237. # 
  2238. # PRIVATE METHOD: _getPdIndex
  2239. #
  2240. # Take a tk index and give me a zero based numerical index
  2241. #
  2242. # Ask the menu widget for the index of the entry denoted by
  2243. # 'tkIndex'. Then if the menu is a tearoff adjust the value
  2244. # to be zero based.
  2245. #
  2246. # This method returns the index as if tearoffs did not exist.
  2247. # Always returns a zero-based index.
  2248. #
  2249. # -------------------------------------------------------------
  2250. body iwidgets::Menubar::_getPdIndex { tkMenuPath tkIndex } {
  2251.  
  2252.     # get the index from the tk menu
  2253.     # this 0 based for non-tearoff and 1-based for tearoffs
  2254.     set pdIndex [$tkMenuPath index $tkIndex]
  2255.  
  2256.     # if there is a tear off make it 0-based index
  2257.     if { [$tkMenuPath cget -tearoff] } {
  2258.         incr pdIndex -1
  2259.     }
  2260.  
  2261.     return $pdIndex
  2262. }
  2263.  
  2264. # -------------------------------------------------------------
  2265. # 
  2266. # PRIVATE METHOD: _getMenuList
  2267. #
  2268. # Returns the list of menus in the order they are on the interface
  2269. # returned list is a list of our menu paths
  2270. #
  2271. # -------------------------------------------------------------
  2272. body iwidgets::Menubar::_getMenuList { } {
  2273.  
  2274.     # get the menus that are packed
  2275.     set tkPathList [pack slaves $itk_component(menubar)]
  2276.  
  2277.     regsub -- {[.]} $itk_component(hull) "" mbName
  2278.     regsub -all -- "\[.\]$mbName\[.\]menubar\[.\]" $tkPathList "." menuPathList
  2279.     return $menuPathList
  2280.     
  2281. }
  2282.  
  2283. # -------------------------------------------------------------
  2284. # 
  2285. # PRIVATE METHOD: _getEntryList
  2286. #
  2287. #
  2288. # This method looks at a menupath and gets all the entries and
  2289. # returns a list of all the entry path names in numerical order
  2290. # based on their index values.
  2291. #
  2292. # MENU is the path to a menu, like .mbar.file.menu or .mbar.file
  2293. # we will calculate a menuPath from this: .mbar.file
  2294. # then we will build a list of entries in this menu excluding the
  2295. # path .mbar.file.menu
  2296. #
  2297. # -------------------------------------------------------------
  2298. body iwidgets::Menubar::_getEntryList { menu } {
  2299.  
  2300.     # if it ends with menu, clip it off
  2301.     regsub {[.]menu$} $menu "" menuPath
  2302.  
  2303.     # first get the complete list of all menu paths
  2304.     set pathList [array names _pathMap]
  2305.  
  2306.     set numEntries 0
  2307.     # iterate over the pathList and put on menuPathList those
  2308.     # that match the menuPattern
  2309.     foreach path $pathList {
  2310.         # if this path is on the menuPath's branch
  2311.         if { [regexp [subst -nocommands {$menuPath[.][^.]*$}] $path] } {
  2312.             # if not a menu itself
  2313.             if { ! [regexp {[.]menu$} $path] } {
  2314.                 set orderedList($_pathMap($path)) $path
  2315.                 incr numEntries
  2316.             }
  2317.         }
  2318.     }
  2319.     set entryList {}
  2320.  
  2321.     for {set i 0} {$i < $numEntries} {incr i} {
  2322.         lappend entryList $orderedList($i)
  2323.     }
  2324.  
  2325.     return $entryList
  2326.  
  2327. }
  2328.     
  2329. # -------------------------------------------------------------
  2330. # 
  2331. # PRIVATE METHOD: _parsePath
  2332. #
  2333. # given path, PATH, _parsePath splits the path name into its
  2334. # component segments. It then puts the name back together one
  2335. # segment at a time and calls _getSymbolicPath to replace the
  2336. # keywords 'last' and 'end' as well as numeric digits.
  2337. #
  2338. # -------------------------------------------------------------
  2339. body iwidgets::Menubar::_parsePath { path } {
  2340.  
  2341.     set segments [split $path .]
  2342.  
  2343.     set concatPath ""
  2344.     foreach seg $segments {
  2345.         if {$seg == ""} {
  2346.             continue
  2347.         }
  2348.         set concatPath $concatPath.$seg
  2349.  
  2350.         set concatPath [_getSymbolicPath $concatPath]
  2351.  
  2352.         if { [catch {set _pathMap($concatPath)} ] } {
  2353.             error "bad path: \"$path\" does not exist. \"$seg\" not valid"
  2354.         }
  2355.     }
  2356.  
  2357.     return $concatPath
  2358. }
  2359.  
  2360. # -------------------------------------------------------------
  2361. # 
  2362. # PRIVATE METHOD: _getSymbolicPath
  2363. #
  2364. # Given a PATH, _getSymbolicPath looks for the last segment of
  2365. # PATH to contain: a number, the keywords last or end. If one
  2366. # of these it figures out how to get us the actual pathname
  2367. # to the searched widget
  2368. #
  2369. # Implementor's notes:
  2370. #    Surely there is a shorter way to do this. The only diff
  2371. #    for non-numeric is getting the llength of the correct list
  2372. #    It is hard to know this upfront so it seems harder to generalize.
  2373. #
  2374. # -------------------------------------------------------------
  2375. body iwidgets::Menubar::_getSymbolicPath { path } {
  2376.  
  2377.     # get the last segment name of the path name
  2378.     regsub {.*[.]} $path "" segment
  2379.  
  2380.     set returnPath $path
  2381.  
  2382.     # if the segment is a number, then look it up positionally
  2383.     # MATCH numeric index
  2384.     if { [regexp {^[0-9]+$} $segment] } {
  2385.  
  2386.         # get the parent prefix
  2387.         regsub {[.][^.]*$} $path "" parent
  2388.  
  2389.         # if we have no parent, then we area menubutton
  2390.         if { $parent == {} } {
  2391.             set menuList [_getMenuList]
  2392.             set returnPath [lindex $menuList $segment]
  2393.         } else {
  2394.             set entryList [_getEntryList $parent.menu]
  2395.             set returnPath [lindex $entryList $segment]
  2396.         }
  2397.  
  2398.     # MATCH 'end' or 'last' keywords.
  2399.     } elseif { [string match end $segment] || \
  2400.                 [string match last $segment]} {
  2401.         # get the parent prefix
  2402.         regsub {[.][^.]*$} $path "" parent
  2403.  
  2404.         # if we have no parent, then we area menubutton
  2405.         if { $parent == {} } {
  2406.             set menuList [_getMenuList]
  2407.             set returnPath [lindex $menuList [expr [llength $menuList] - 1]]
  2408.         } else {
  2409.             set entryList [_getEntryList $parent.menu]
  2410.             set returnPath [lindex $entryList [expr [llength $entryList] - 1]]
  2411.         }
  2412.     }
  2413.  
  2414.     return $returnPath
  2415. }
  2416.  
  2417. # -------------------------------------------------------------
  2418. # 
  2419. # PROTECTED METHOD: _leaveHandler
  2420. #
  2421. # Bound to the <Leave> event on a menu pane. This clears the
  2422. # status widget help area and resets the help entry.
  2423. #
  2424. # -------------------------------------------------------------
  2425. body iwidgets::Menubar::_leaveHandler { menuPath } {
  2426.  
  2427.     if { $itk_option(-helpvariable) == {} } {
  2428.         return
  2429.     }
  2430.  
  2431.     set $itk_option(-helpvariable) {}
  2432.     set _entryIndex -1
  2433. }
  2434.  
  2435. # -------------------------------------------------------------
  2436. # 
  2437. # PROTECTED METHOD: _helpHandler
  2438. #
  2439. # Bound to the <Motion> event on a menu pane. This puts the
  2440. # help string associated with the menu entry into the 
  2441. # status widget help area. If no help exists for the current
  2442. # entry, the status widget is cleared.
  2443. #
  2444. # -------------------------------------------------------------
  2445. body iwidgets::Menubar::_helpHandler { menuPath menuY } {
  2446.  
  2447.     if { $itk_option(-helpvariable) == {} } {
  2448.         return
  2449.     }
  2450.  
  2451.     set tkMenuWidget $_pathMap($menuPath)
  2452.     set entryIndex [$tkMenuWidget index @$menuY]
  2453.  
  2454.     # already on this item?
  2455.     if { $entryIndex == $_entryIndex } {
  2456.         return
  2457.     }
  2458.  
  2459.     set _entryIndex $entryIndex
  2460.  
  2461.     set entries [_getEntryList $menuPath]
  2462.  
  2463.     set menuEntryHit \
  2464.             [lindex $entries [_getPdIndex $tkMenuWidget $entryIndex]]
  2465.  
  2466.     # helpvariable set for our Menubar?
  2467.     if { $itk_option(-helpvariable) != {} } {
  2468.  
  2469.         # blank out the old one
  2470.         set $itk_option(-helpvariable) {}
  2471.  
  2472.         # if there are options for this entry
  2473.         if { ! [catch {set _options($menuEntryHit)} ] } {
  2474.             foreach option $_options($menuEntryHit) {
  2475.                 # if we find the -helpstr option for this widget.
  2476.                 set args "-helpstr"
  2477.                 if { [string match [$option cget -switch] $args] } {
  2478.                     set val [lindex [$option get $args] 4]
  2479.                     if { $val != {} } {
  2480.                         set $itk_option(-helpvariable) $val
  2481.                     }
  2482.                 }
  2483.             }
  2484.         }
  2485.  
  2486.     }
  2487. }
  2488.  
  2489. # -------------------------------------------------------------
  2490. #
  2491. # PRIVATE METHOD: _getCallerLevel
  2492. #
  2493. # Starts at stack frame #0 and works down till we either hit
  2494. # a ::Menubar stack frame or an ::itk::Archetype stack frame 
  2495. # (the latter happens when a configure is called via the 'component'
  2496. # method
  2497. #
  2498. # Returns the level of the actual caller of the menubar command
  2499. # in the form of #num where num is the level number caller stack frame.
  2500. #
  2501. # -------------------------------------------------------------
  2502. body iwidgets::Menubar::_getCallerLevel { } {
  2503.  
  2504.     set levelName {}
  2505.     set levelsAreValid true
  2506.     set level 0
  2507.     set callerLevel #$level
  2508.  
  2509.     while { $levelsAreValid } {
  2510.         # Hit the end of the stack frame
  2511.         if [catch {uplevel #$level {namespace current}}] {
  2512.             set levelsAreValid false
  2513.             set callerLevel #[expr $level - 1]
  2514.         # still going
  2515.         } else {
  2516.             set newLevelName [uplevel #$level {namespace current}]
  2517.             # See if we have run into the first ::Menubar level
  2518.             if { $newLevelName == "::itk::Archetype" || \
  2519.                             $newLevelName == "::iwidgets::Menubar" } {
  2520.                 # If so, we are done-- set the callerLevel
  2521.                 set levelsAreValid false
  2522.                 set callerLevel #[expr $level - 1]
  2523.             } else {
  2524.                 set levelName $newLevelName
  2525.             }
  2526.         }
  2527.         incr level
  2528.     }
  2529.     return $callerLevel
  2530. }
  2531.