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