home *** CD-ROM | disk | FTP | other *** search
/ PC World 2002 May / PCWorld_2002-05_cd.bin / Software / TemaCD / activetcltk / ActiveTcl8.3.4.1-8.win32-ix86.exe / ActiveTcl8.3.4.1-win32-ix86 / lib / tk8.3 / menu.tcl < prev    next >
Encoding:
Text File  |  2001-10-22  |  35.9 KB  |  1,285 lines
  1. # menu.tcl --
  2. #
  3. # This file defines the default bindings for Tk menus and menubuttons.
  4. # It also implements keyboard traversal of menus and implements a few
  5. # other utility procedures related to menus.
  6. #
  7. # RCS: @(#) $Id: menu.tcl,v 1.12 2000/04/17 19:32:00 ericm Exp $
  8. #
  9. # Copyright (c) 1992-1994 The Regents of the University of California.
  10. # Copyright (c) 1994-1997 Sun Microsystems, Inc.
  11. # Copyright (c) 1998-1999 by Scriptics Corporation.
  12. #
  13. # See the file "license.terms" for information on usage and redistribution
  14. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  15. #
  16.  
  17. #-------------------------------------------------------------------------
  18. # Elements of tkPriv that are used in this file:
  19. #
  20. # cursor -        Saves the -cursor option for the posted menubutton.
  21. # focus -        Saves the focus during a menu selection operation.
  22. #            Focus gets restored here when the menu is unposted.
  23. # grabGlobal -        Used in conjunction with tkPriv(oldGrab):  if
  24. #            tkPriv(oldGrab) is non-empty, then tkPriv(grabGlobal)
  25. #            contains either an empty string or "-global" to
  26. #            indicate whether the old grab was a local one or
  27. #            a global one.
  28. # inMenubutton -    The name of the menubutton widget containing
  29. #            the mouse, or an empty string if the mouse is
  30. #            not over any menubutton.
  31. # menuBar -        The name of the menubar that is the root
  32. #            of the cascade hierarchy which is currently
  33. #            posted. This is null when there is no menu currently
  34. #            being pulled down from a menu bar.
  35. # oldGrab -        Window that had the grab before a menu was posted.
  36. #            Used to restore the grab state after the menu
  37. #            is unposted.  Empty string means there was no
  38. #            grab previously set.
  39. # popup -        If a menu has been popped up via tk_popup, this
  40. #            gives the name of the menu.  Otherwise this
  41. #            value is empty.
  42. # postedMb -        Name of the menubutton whose menu is currently
  43. #            posted, or an empty string if nothing is posted
  44. #            A grab is set on this widget.
  45. # relief -        Used to save the original relief of the current
  46. #            menubutton.
  47. # window -        When the mouse is over a menu, this holds the
  48. #            name of the menu;  it's cleared when the mouse
  49. #            leaves the menu.
  50. # tearoff -        Whether the last menu posted was a tearoff or not.
  51. #            This is true always for unix, for tearoffs for Mac
  52. #            and Windows.
  53. # activeMenu -        This is the last active menu for use
  54. #            with the <<MenuSelect>> virtual event.
  55. # activeItem -        This is the last active menu item for
  56. #            use with the <<MenuSelect>> virtual event.
  57. #-------------------------------------------------------------------------
  58.  
  59. #-------------------------------------------------------------------------
  60. # Overall note:
  61. # This file is tricky because there are five different ways that menus
  62. # can be used:
  63. #
  64. # 1. As a pulldown from a menubutton. In this style, the variable 
  65. #    tkPriv(postedMb) identifies the posted menubutton.
  66. # 2. As a torn-off menu copied from some other menu.  In this style
  67. #    tkPriv(postedMb) is empty, and menu's type is "tearoff".
  68. # 3. As an option menu, triggered from an option menubutton.  In this
  69. #    style tkPriv(postedMb) identifies the posted menubutton.
  70. # 4. As a popup menu.  In this style tkPriv(postedMb) is empty and
  71. #    the top-level menu's type is "normal".
  72. # 5. As a pulldown from a menubar. The variable tkPriv(menubar) has
  73. #    the owning menubar, and the menu itself is of type "normal".
  74. #
  75. # The various binding procedures use the  state described above to
  76. # distinguish the various cases and take different actions in each
  77. # case.
  78. #-------------------------------------------------------------------------
  79.  
  80. #-------------------------------------------------------------------------
  81. # The code below creates the default class bindings for menus
  82. # and menubuttons.
  83. #-------------------------------------------------------------------------
  84.  
  85. bind Menubutton <FocusIn> {}
  86. bind Menubutton <Enter> {
  87.     tkMbEnter %W
  88. }
  89. bind Menubutton <Leave> {
  90.     tkMbLeave %W
  91. }
  92. bind Menubutton <1> {
  93.     if {[string compare $tkPriv(inMenubutton) ""]} {
  94.     tkMbPost $tkPriv(inMenubutton) %X %Y
  95.     }
  96. }
  97. bind Menubutton <Motion> {
  98.     tkMbMotion %W up %X %Y
  99. }
  100. bind Menubutton <B1-Motion> {
  101.     tkMbMotion %W down %X %Y
  102. }
  103. bind Menubutton <ButtonRelease-1> {
  104.     tkMbButtonUp %W
  105. }
  106. bind Menubutton <space> {
  107.     tkMbPost %W
  108.     tkMenuFirstEntry [%W cget -menu]
  109. }
  110.  
  111. # Must set focus when mouse enters a menu, in order to allow
  112. # mixed-mode processing using both the mouse and the keyboard.
  113. # Don't set the focus if the event comes from a grab release,
  114. # though:  such an event can happen after as part of unposting
  115. # a cascaded chain of menus, after the focus has already been
  116. # restored to wherever it was before menu selection started.
  117.  
  118. bind Menu <FocusIn> {}
  119.  
  120. bind Menu <Enter> {
  121.     set tkPriv(window) %W
  122.     if {[string equal [%W cget -type] "tearoff"]} {
  123.     if {[string compare "%m" "NotifyUngrab"]} {
  124.         if {[string equal $tcl_platform(platform) "unix"]} {
  125.         tk_menuSetFocus %W
  126.         }
  127.     }
  128.     }
  129.     tkMenuMotion %W %x %y %s
  130. }
  131.  
  132. bind Menu <Leave> {
  133.     tkMenuLeave %W %X %Y %s
  134. }
  135. bind Menu <Motion> {
  136.     tkMenuMotion %W %x %y %s
  137. }
  138. bind Menu <ButtonPress> {
  139.     tkMenuButtonDown %W
  140. }
  141. bind Menu <ButtonRelease> {
  142.    tkMenuInvoke %W 1
  143. }
  144. bind Menu <space> {
  145.     tkMenuInvoke %W 0
  146. }
  147. bind Menu <Return> {
  148.     tkMenuInvoke %W 0
  149. }
  150. bind Menu <Escape> {
  151.     tkMenuEscape %W
  152. }
  153. bind Menu <Left> {
  154.     tkMenuLeftArrow %W
  155. }
  156. bind Menu <Right> {
  157.     tkMenuRightArrow %W
  158. }
  159. bind Menu <Up> {
  160.     tkMenuUpArrow %W
  161. }
  162. bind Menu <Down> {
  163.     tkMenuDownArrow %W
  164. }
  165. bind Menu <KeyPress> {
  166.     tkTraverseWithinMenu %W %A
  167. }
  168.  
  169. # The following bindings apply to all windows, and are used to
  170. # implement keyboard menu traversal.
  171.  
  172. if {[string equal $tcl_platform(platform) "unix"]} {
  173.     bind all <Alt-KeyPress> {
  174.     tkTraverseToMenu %W %A
  175.     }
  176.  
  177.     bind all <F10> {
  178.     tkFirstMenu %W
  179.     }
  180. } else {
  181.     bind Menubutton <Alt-KeyPress> {
  182.     tkTraverseToMenu %W %A
  183.     }
  184.  
  185.     bind Menubutton <F10> {
  186.     tkFirstMenu %W
  187.     }
  188. }
  189.  
  190. # tkMbEnter --
  191. # This procedure is invoked when the mouse enters a menubutton
  192. # widget.  It activates the widget unless it is disabled.  Note:
  193. # this procedure is only invoked when mouse button 1 is *not* down.
  194. # The procedure tkMbB1Enter is invoked if the button is down.
  195. #
  196. # Arguments:
  197. # w -            The  name of the widget.
  198.  
  199. proc tkMbEnter w {
  200.     global tkPriv
  201.  
  202.     if {[string compare $tkPriv(inMenubutton) ""]} {
  203.     tkMbLeave $tkPriv(inMenubutton)
  204.     }
  205.     set tkPriv(inMenubutton) $w
  206.     if {[string compare [$w cget -state] "disabled"]} {
  207.     $w configure -state active
  208.     }
  209. }
  210.  
  211. # tkMbLeave --
  212. # This procedure is invoked when the mouse leaves a menubutton widget.
  213. # It de-activates the widget, if the widget still exists.
  214. #
  215. # Arguments:
  216. # w -            The  name of the widget.
  217.  
  218. proc tkMbLeave w {
  219.     global tkPriv
  220.  
  221.     set tkPriv(inMenubutton) {}
  222.     if {![winfo exists $w]} {
  223.     return
  224.     }
  225.     if {[string equal [$w cget -state] "active"]} {
  226.     $w configure -state normal
  227.     }
  228. }
  229.  
  230. # tkMbPost --
  231. # Given a menubutton, this procedure does all the work of posting
  232. # its associated menu and unposting any other menu that is currently
  233. # posted.
  234. #
  235. # Arguments:
  236. # w -            The name of the menubutton widget whose menu
  237. #            is to be posted.
  238. # x, y -        Root coordinates of cursor, used for positioning
  239. #            option menus.  If not specified, then the center
  240. #            of the menubutton is used for an option menu.
  241.  
  242. proc tkMbPost {w {x {}} {y {}}} {
  243.     global tkPriv errorInfo
  244.     global tcl_platform
  245.  
  246.     if {[string equal [$w cget -state] "disabled"] || \
  247.         [string equal $w $tkPriv(postedMb)]} {
  248.     return
  249.     }
  250.     set menu [$w cget -menu]
  251.     if {[string equal $menu ""]} {
  252.     return
  253.     }
  254.     set tearoff [expr {[string equal $tcl_platform(platform) "unix"] \
  255.         || [string equal [$menu cget -type] "tearoff"]}]
  256.     if {[string first $w $menu] != 0} {
  257.     error "can't post $menu:  it isn't a descendant of $w (this is a new requirement in Tk versions 3.0 and later)"
  258.     }
  259.     set cur $tkPriv(postedMb)
  260.     if {[string compare $cur ""]} {
  261.     tkMenuUnpost {}
  262.     }
  263.     set tkPriv(cursor) [$w cget -cursor]
  264.     set tkPriv(relief) [$w cget -relief]
  265.     $w configure -cursor arrow
  266.     $w configure -relief raised
  267.  
  268.     set tkPriv(postedMb) $w
  269.     set tkPriv(focus) [focus]
  270.     $menu activate none
  271.     tkGenerateMenuSelect $menu
  272.  
  273.     # If this looks like an option menubutton then post the menu so
  274.     # that the current entry is on top of the mouse.  Otherwise post
  275.     # the menu just below the menubutton, as for a pull-down.
  276.  
  277.     update idletasks
  278.     if {[catch {
  279.     switch [$w cget -direction] {
  280.             above {
  281.                 set x [winfo rootx $w]
  282.                 set y [expr {[winfo rooty $w] - [winfo reqheight $menu]}]
  283.                 $menu post $x $y
  284.             }
  285.             below {
  286.                 set x [winfo rootx $w]
  287.                 set y [expr {[winfo rooty $w] + [winfo height $w]}]
  288.                 $menu post $x $y
  289.             }
  290.             left {
  291.                 set x [expr {[winfo rootx $w] - [winfo reqwidth $menu]}]
  292.                 set y [expr {(2 * [winfo rooty $w] + [winfo height $w]) / 2}]
  293.                 set entry [tkMenuFindName $menu [$w cget -text]]
  294.                 if {[$w cget -indicatoron]} {
  295.             if {$entry == [$menu index last]} {
  296.                 incr y [expr {-([$menu yposition $entry] \
  297.                     + [winfo reqheight $menu])/2}]
  298.             } else {
  299.                 incr y [expr {-([$menu yposition $entry] \
  300.                     + [$menu yposition [expr {$entry+1}]])/2}]
  301.             }
  302.                 }
  303.                 $menu post $x $y
  304.         if {[string compare $entry {}] && [string compare [$menu entrycget $entry -state] "disabled"]} {
  305.                     $menu activate $entry
  306.             tkGenerateMenuSelect $menu
  307.                 }
  308.             }
  309.             right {
  310.                 set x [expr {[winfo rootx $w] + [winfo width $w]}]
  311.                 set y [expr {(2 * [winfo rooty $w] + [winfo height $w]) / 2}]
  312.                 set entry [tkMenuFindName $menu [$w cget -text]]
  313.                 if {[$w cget -indicatoron]} {
  314.             if {$entry == [$menu index last]} {
  315.                 incr y [expr {-([$menu yposition $entry] \
  316.                     + [winfo reqheight $menu])/2}]
  317.             } else {
  318.                 incr y [expr {-([$menu yposition $entry] \
  319.                     + [$menu yposition [expr {$entry+1}]])/2}]
  320.             }
  321.                 }
  322.                 $menu post $x $y
  323.         if {[string compare $entry {}] && [string compare [$menu entrycget $entry -state] "disabled"]} {
  324.                     $menu activate $entry
  325.             tkGenerateMenuSelect $menu
  326.                 }
  327.             }
  328.             default {
  329.                 if {[$w cget -indicatoron]} {
  330.             if {[string equal $y {}]} {
  331.             set x [expr {[winfo rootx $w] + [winfo width $w]/2}]
  332.             set y [expr {[winfo rooty $w] + [winfo height $w]/2}]
  333.                 }
  334.                 tkPostOverPoint $menu $x $y [tkMenuFindName $menu [$w cget -text]]
  335.         } else {
  336.                 $menu post [winfo rootx $w] [expr {[winfo rooty $w]+[winfo height $w]}]
  337.                 }  
  338.             }
  339.     }
  340.     } msg]} {
  341.     # Error posting menu (e.g. bogus -postcommand). Unpost it and
  342.     # reflect the error.
  343.     
  344.     set savedInfo $errorInfo
  345.     tkMenuUnpost {}
  346.     error $msg $savedInfo
  347.  
  348.     }
  349.  
  350.     set tkPriv(tearoff) $tearoff
  351.     if {$tearoff != 0} {
  352.         focus $menu
  353.     if {[winfo viewable $w]} {
  354.         tkSaveGrabInfo $w
  355.         grab -global $w
  356.     }
  357.     }
  358. }
  359.  
  360. # tkMenuUnpost --
  361. # This procedure unposts a given menu, plus all of its ancestors up
  362. # to (and including) a menubutton, if any.  It also restores various
  363. # values to what they were before the menu was posted, and releases
  364. # a grab if there's a menubutton involved.  Special notes:
  365. # 1. It's important to unpost all menus before releasing the grab, so
  366. #    that any Enter-Leave events (e.g. from menu back to main
  367. #    application) have mode NotifyGrab.
  368. # 2. Be sure to enclose various groups of commands in "catch" so that
  369. #    the procedure will complete even if the menubutton or the menu
  370. #    or the grab window has been deleted.
  371. #
  372. # Arguments:
  373. # menu -        Name of a menu to unpost.  Ignored if there
  374. #            is a posted menubutton.
  375.  
  376. proc tkMenuUnpost menu {
  377.     global tcl_platform
  378.     global tkPriv
  379.     set mb $tkPriv(postedMb)
  380.  
  381.     # Restore focus right away (otherwise X will take focus away when
  382.     # the menu is unmapped and under some window managers (e.g. olvwm)
  383.     # we'll lose the focus completely).
  384.  
  385.     catch {focus $tkPriv(focus)}
  386.     set tkPriv(focus) ""
  387.  
  388.     # Unpost menu(s) and restore some stuff that's dependent on
  389.     # what was posted.
  390.  
  391.     catch {
  392.     if {[string compare $mb ""]} {
  393.         set menu [$mb cget -menu]
  394.         $menu unpost
  395.         set tkPriv(postedMb) {}
  396.         $mb configure -cursor $tkPriv(cursor)
  397.         $mb configure -relief $tkPriv(relief)
  398.     } elseif {[string compare $tkPriv(popup) ""]} {
  399.         $tkPriv(popup) unpost
  400.         set tkPriv(popup) {}
  401.     } elseif {[string compare [$menu cget -type] "menubar"] \
  402.         && [string compare [$menu cget -type] "tearoff"]} {
  403.         # We're in a cascaded sub-menu from a torn-off menu or popup.
  404.         # Unpost all the menus up to the toplevel one (but not
  405.         # including the top-level torn-off one) and deactivate the
  406.         # top-level torn off menu if there is one.
  407.  
  408.         while {1} {
  409.         set parent [winfo parent $menu]
  410.         if {[string compare [winfo class $parent] "Menu"] \
  411.             || ![winfo ismapped $parent]} {
  412.             break
  413.         }
  414.         $parent activate none
  415.         $parent postcascade none
  416.         tkGenerateMenuSelect $parent
  417.         set type [$parent cget -type]
  418.         if {[string equal $type "menubar"] || \
  419.             [string equal $type "tearoff"]} {
  420.             break
  421.         }
  422.         set menu $parent
  423.         }
  424.         if {[string compare [$menu cget -type] "menubar"]} {
  425.         $menu unpost
  426.         }
  427.     }
  428.     }
  429.  
  430.     if {($tkPriv(tearoff) != 0) || [string compare $tkPriv(menuBar) ""]} {
  431.         # Release grab, if any, and restore the previous grab, if there
  432.         # was one.
  433.     if {[string compare $menu ""]} {
  434.         set grab [grab current $menu]
  435.         if {[string compare $grab ""]} {
  436.         grab release $grab
  437.         }
  438.     }
  439.     tkRestoreOldGrab
  440.     if {[string compare $tkPriv(menuBar) ""]} {
  441.         $tkPriv(menuBar) configure -cursor $tkPriv(cursor)
  442.         set tkPriv(menuBar) {}
  443.     }
  444.     if {[string compare $tcl_platform(platform) "unix"]} {
  445.         set tkPriv(tearoff) 0
  446.     }
  447.     }
  448. }
  449.  
  450. # tkMbMotion --
  451. # This procedure handles mouse motion events inside menubuttons, and
  452. # also outside menubuttons when a menubutton has a grab (e.g. when a
  453. # menu selection operation is in progress).
  454. #
  455. # Arguments:
  456. # w -            The name of the menubutton widget.
  457. # upDown -         "down" means button 1 is pressed, "up" means
  458. #            it isn't.
  459. # rootx, rooty -    Coordinates of mouse, in (virtual?) root window.
  460.  
  461. proc tkMbMotion {w upDown rootx rooty} {
  462.     global tkPriv
  463.  
  464.     if {[string equal $tkPriv(inMenubutton) $w]} {
  465.     return
  466.     }
  467.     set new [winfo containing $rootx $rooty]
  468.     if {[string compare $new $tkPriv(inMenubutton)] \
  469.         && ([string equal $new ""] \
  470.         || [string equal [winfo toplevel $new] [winfo toplevel $w]])} {
  471.     if {[string compare $tkPriv(inMenubutton) ""]} {
  472.         tkMbLeave $tkPriv(inMenubutton)
  473.     }
  474.     if {[string compare $new ""] \
  475.         && [string equal [winfo class $new] "Menubutton"] \
  476.         && ([$new cget -indicatoron] == 0) \
  477.         && ([$w cget -indicatoron] == 0)} {
  478.         if {[string equal $upDown "down"]} {
  479.         tkMbPost $new $rootx $rooty
  480.         } else {
  481.         tkMbEnter $new
  482.         }
  483.     }
  484.     }
  485. }
  486.  
  487. # tkMbButtonUp --
  488. # This procedure is invoked to handle button 1 releases for menubuttons.
  489. # If the release happens inside the menubutton then leave its menu
  490. # posted with element 0 activated.  Otherwise, unpost the menu.
  491. #
  492. # Arguments:
  493. # w -            The name of the menubutton widget.
  494.  
  495. proc tkMbButtonUp w {
  496.     global tkPriv
  497.     global tcl_platform
  498.  
  499.     set menu [$w cget -menu]
  500.     set tearoff [expr {[string equal $tcl_platform(platform) "unix"] || \
  501.         ([string compare $menu {}] && \
  502.         [string equal [$menu cget -type] "tearoff"])}]
  503.     if {($tearoff != 0) && [string equal $tkPriv(postedMb) $w] \
  504.         && [string equal $tkPriv(inMenubutton) $w]} {
  505.     tkMenuFirstEntry [$tkPriv(postedMb) cget -menu]
  506.     } else {
  507.     tkMenuUnpost {}
  508.     }
  509. }
  510.  
  511. # tkMenuMotion --
  512. # This procedure is called to handle mouse motion events for menus.
  513. # It does two things.  First, it resets the active element in the
  514. # menu, if the mouse is over the menu.  Second, if a mouse button
  515. # is down, it posts and unposts cascade entries to match the mouse
  516. # position.
  517. #
  518. # Arguments:
  519. # menu -        The menu window.
  520. # x -            The x position of the mouse.
  521. # y -            The y position of the mouse.
  522. # state -        Modifier state (tells whether buttons are down).
  523.  
  524. proc tkMenuMotion {menu x y state} {
  525.     global tkPriv
  526.     if {[string equal $menu $tkPriv(window)]} {
  527.     if {[string equal [$menu cget -type] "menubar"]} {
  528.         if {[info exists tkPriv(focus)] && \
  529.             [string compare $menu $tkPriv(focus)]} {
  530.         $menu activate @$x,$y
  531.         tkGenerateMenuSelect $menu
  532.         }
  533.     } else {
  534.         $menu activate @$x,$y
  535.         tkGenerateMenuSelect $menu
  536.     }
  537.     }
  538.     if {($state & 0x1f00) != 0} {
  539.     $menu postcascade active
  540.     }
  541. }
  542.  
  543. # tkMenuButtonDown --
  544. # Handles button presses in menus.  There are a couple of tricky things
  545. # here:
  546. # 1. Change the posted cascade entry (if any) to match the mouse position.
  547. # 2. If there is a posted menubutton, must grab to the menubutton;  this
  548. #    overrrides the implicit grab on button press, so that the menu
  549. #    button can track mouse motions over other menubuttons and change
  550. #    the posted menu.
  551. # 3. If there's no posted menubutton (e.g. because we're a torn-off menu
  552. #    or one of its descendants) must grab to the top-level menu so that
  553. #    we can track mouse motions across the entire menu hierarchy.
  554. #
  555. # Arguments:
  556. # menu -        The menu window.
  557.  
  558. proc tkMenuButtonDown menu {
  559.     global tkPriv
  560.     global tcl_platform
  561.  
  562.     if {![winfo viewable $menu]} {
  563.         return
  564.     }
  565.     $menu postcascade active
  566.     if {[string compare $tkPriv(postedMb) ""] && \
  567.         [winfo viewable $tkPriv(postedMb)]} {
  568.     grab -global $tkPriv(postedMb)
  569.     } else {
  570.     while {[string equal [$menu cget -type] "normal"] \
  571.         && [string equal [winfo class [winfo parent $menu]] "Menu"] \
  572.         && [winfo ismapped [winfo parent $menu]]} {
  573.         set menu [winfo parent $menu]
  574.     }
  575.  
  576.     if {[string equal $tkPriv(menuBar) {}]} {
  577.         set tkPriv(menuBar) $menu
  578.         set tkPriv(cursor) [$menu cget -cursor]
  579.         $menu configure -cursor arrow
  580.         }
  581.  
  582.     # Don't update grab information if the grab window isn't changing.
  583.     # Otherwise, we'll get an error when we unpost the menus and
  584.     # restore the grab, since the old grab window will not be viewable
  585.     # anymore.
  586.  
  587.     if {[string compare $menu [grab current $menu]]} {
  588.         tkSaveGrabInfo $menu
  589.     }
  590.  
  591.     # Must re-grab even if the grab window hasn't changed, in order
  592.     # to release the implicit grab from the button press.
  593.  
  594.     if {[string equal $tcl_platform(platform) "unix"]} {
  595.         grab -global $menu
  596.     }
  597.     }
  598. }
  599.  
  600. # tkMenuLeave --
  601. # This procedure is invoked to handle Leave events for a menu.  It
  602. # deactivates everything unless the active element is a cascade element
  603. # and the mouse is now over the submenu.
  604. #
  605. # Arguments:
  606. # menu -        The menu window.
  607. # rootx, rooty -    Root coordinates of mouse.
  608. # state -        Modifier state.
  609.  
  610. proc tkMenuLeave {menu rootx rooty state} {
  611.     global tkPriv
  612.     set tkPriv(window) {}
  613.     if {[string equal [$menu index active] "none"]} {
  614.     return
  615.     }
  616.     if {[string equal [$menu type active] "cascade"]
  617.           && [string equal [winfo containing $rootx $rooty] \
  618.                   [$menu entrycget active -menu]]} {
  619.     return
  620.     }
  621.     $menu activate none
  622.     tkGenerateMenuSelect $menu
  623. }
  624.  
  625. # tkMenuInvoke --
  626. # This procedure is invoked when button 1 is released over a menu.
  627. # It invokes the appropriate menu action and unposts the menu if
  628. # it came from a menubutton.
  629. #
  630. # Arguments:
  631. # w -            Name of the menu widget.
  632. # buttonRelease -    1 means this procedure is called because of
  633. #            a button release;  0 means because of keystroke.
  634.  
  635. proc tkMenuInvoke {w buttonRelease} {
  636.     global tkPriv
  637.  
  638.     if {$buttonRelease && [string equal $tkPriv(window) {}]} {
  639.     # Mouse was pressed over a menu without a menu button, then
  640.     # dragged off the menu (possibly with a cascade posted) and
  641.     # released.  Unpost everything and quit.
  642.  
  643.     $w postcascade none
  644.     $w activate none
  645.     event generate $w <<MenuSelect>>
  646.     tkMenuUnpost $w
  647.     return
  648.     }
  649.     if {[string equal [$w type active] "cascade"]} {
  650.     $w postcascade active
  651.     set menu [$w entrycget active -menu]
  652.     tkMenuFirstEntry $menu
  653.     } elseif {[string equal [$w type active] "tearoff"]} {
  654.     tkTearOffMenu $w
  655.     tkMenuUnpost $w
  656.     } elseif {[string equal [$w cget -type] "menubar"]} {
  657.     $w postcascade none
  658.     set active [$w index active]
  659.     set isCascade [string equal [$w type $active] "cascade"]
  660.  
  661.     # Only de-activate the active item if it's a cascade; this prevents
  662.     # the annoying "activation flicker" you otherwise get with 
  663.     # checkbuttons/commands/etc. on menubars
  664.  
  665.     if { $isCascade } {
  666.         $w activate none
  667.         event generate $w <<MenuSelect>>
  668.     }
  669.  
  670.     tkMenuUnpost $w
  671.  
  672.     # If the active item is not a cascade, invoke it.  This enables
  673.     # the use of checkbuttons/commands/etc. on menubars (which is legal,
  674.     # but not recommended)
  675.  
  676.     if { !$isCascade } {
  677.         uplevel #0 [list $w invoke $active]
  678.     }
  679.     } else {
  680.     tkMenuUnpost $w
  681.     uplevel #0 [list $w invoke active]
  682.     }
  683. }
  684.  
  685. # tkMenuEscape --
  686. # This procedure is invoked for the Cancel (or Escape) key.  It unposts
  687. # the given menu and, if it is the top-level menu for a menu button,
  688. # unposts the menu button as well.
  689. #
  690. # Arguments:
  691. # menu -        Name of the menu window.
  692.  
  693. proc tkMenuEscape menu {
  694.     set parent [winfo parent $menu]
  695.     if {[string compare [winfo class $parent] "Menu"]} {
  696.     tkMenuUnpost $menu
  697.     } elseif {[string equal [$parent cget -type] "menubar"]} {
  698.     tkMenuUnpost $menu
  699.     tkRestoreOldGrab
  700.     } else {
  701.     tkMenuNextMenu $menu left
  702.     }
  703. }
  704.  
  705. # The following routines handle arrow keys. Arrow keys behave
  706. # differently depending on whether the menu is a menu bar or not.
  707.  
  708. proc tkMenuUpArrow {menu} {
  709.     if {[string equal [$menu cget -type] "menubar"]} {
  710.     tkMenuNextMenu $menu left
  711.     } else {
  712.     tkMenuNextEntry $menu -1
  713.     }
  714. }
  715.  
  716. proc tkMenuDownArrow {menu} {
  717.     if {[string equal [$menu cget -type] "menubar"]} {
  718.     tkMenuNextMenu $menu right
  719.     } else {
  720.     tkMenuNextEntry $menu 1
  721.     }
  722. }
  723.  
  724. proc tkMenuLeftArrow {menu} {
  725.     if {[string equal [$menu cget -type] "menubar"]} {
  726.     tkMenuNextEntry $menu -1
  727.     } else {
  728.     tkMenuNextMenu $menu left
  729.     }
  730. }
  731.  
  732. proc tkMenuRightArrow {menu} {
  733.     if {[string equal [$menu cget -type] "menubar"]} {
  734.     tkMenuNextEntry $menu 1
  735.     } else {
  736.     tkMenuNextMenu $menu right
  737.     }
  738. }
  739.  
  740. # tkMenuNextMenu --
  741. # This procedure is invoked to handle "left" and "right" traversal
  742. # motions in menus.  It traverses to the next menu in a menu bar,
  743. # or into or out of a cascaded menu.
  744. #
  745. # Arguments:
  746. # menu -        The menu that received the keyboard
  747. #            event.
  748. # direction -        Direction in which to move: "left" or "right"
  749.  
  750. proc tkMenuNextMenu {menu direction} {
  751.     global tkPriv
  752.  
  753.     # First handle traversals into and out of cascaded menus.
  754.  
  755.     if {[string equal $direction "right"]} {
  756.     set count 1
  757.     set parent [winfo parent $menu]
  758.     set class [winfo class $parent]
  759.     if {[string equal [$menu type active] "cascade"]} {
  760.         $menu postcascade active
  761.         set m2 [$menu entrycget active -menu]
  762.         if {[string compare $m2 ""]} {
  763.         tkMenuFirstEntry $m2
  764.         }
  765.         return
  766.     } else {
  767.         set parent [winfo parent $menu]
  768.         while {[string compare $parent "."]} {
  769.         if {[string equal [winfo class $parent] "Menu"] \
  770.             && [string equal [$parent cget -type] "menubar"]} {
  771.             tk_menuSetFocus $parent
  772.             tkMenuNextEntry $parent 1
  773.             return
  774.         }
  775.         set parent [winfo parent $parent]
  776.         }
  777.     }
  778.     } else {
  779.     set count -1
  780.     set m2 [winfo parent $menu]
  781.     if {[string equal [winfo class $m2] "Menu"]} {
  782.         if {[string compare [$m2 cget -type] "menubar"]} {
  783.         $menu activate none
  784.         tkGenerateMenuSelect $menu
  785.         tk_menuSetFocus $m2
  786.         
  787.         # This code unposts any posted submenu in the parent.
  788.         
  789.         set tmp [$m2 index active]
  790.         $m2 activate none
  791.         $m2 activate $tmp
  792.         return
  793.         }
  794.     }
  795.     }
  796.  
  797.     # Can't traverse into or out of a cascaded menu.  Go to the next
  798.     # or previous menubutton, if that makes sense.
  799.  
  800.     set m2 [winfo parent $menu]
  801.     if {[string equal [winfo class $m2] "Menu"]} {
  802.     if {[string equal [$m2 cget -type] "menubar"]} {
  803.         tk_menuSetFocus $m2
  804.         tkMenuNextEntry $m2 -1
  805.         return
  806.     }
  807.     }
  808.  
  809.     set w $tkPriv(postedMb)
  810.     if {[string equal $w ""]} {
  811.     return
  812.     }
  813.     set buttons [winfo children [winfo parent $w]]
  814.     set length [llength $buttons]
  815.     set i [expr {[lsearch -exact $buttons $w] + $count}]
  816.     while {1} {
  817.     while {$i < 0} {
  818.         incr i $length
  819.     }
  820.     while {$i >= $length} {
  821.         incr i -$length
  822.     }
  823.     set mb [lindex $buttons $i]
  824.     if {[string equal [winfo class $mb] "Menubutton"] \
  825.         && [string compare [$mb cget -state] "disabled"] \
  826.         && [string compare [$mb cget -menu] ""] \
  827.         && [string compare [[$mb cget -menu] index last] "none"]} {
  828.         break
  829.     }
  830.     if {[string equal $mb $w]} {
  831.         return
  832.     }
  833.     incr i $count
  834.     }
  835.     tkMbPost $mb
  836.     tkMenuFirstEntry [$mb cget -menu]
  837. }
  838.  
  839. # tkMenuNextEntry --
  840. # Activate the next higher or lower entry in the posted menu,
  841. # wrapping around at the ends.  Disabled entries are skipped.
  842. #
  843. # Arguments:
  844. # menu -            Menu window that received the keystroke.
  845. # count -            1 means go to the next lower entry,
  846. #                -1 means go to the next higher entry.
  847.  
  848. proc tkMenuNextEntry {menu count} {
  849.     global tkPriv
  850.  
  851.     if {[string equal [$menu index last] "none"]} {
  852.     return
  853.     }
  854.     set length [expr {[$menu index last]+1}]
  855.     set quitAfter $length
  856.     set active [$menu index active]
  857.     if {[string equal $active "none"]} {
  858.     set i 0
  859.     } else {
  860.     set i [expr {$active + $count}]
  861.     }
  862.     while {1} {
  863.     if {$quitAfter <= 0} {
  864.         # We've tried every entry in the menu.  Either there are
  865.         # none, or they're all disabled.  Just give up.
  866.  
  867.         return
  868.     }
  869.     while {$i < 0} {
  870.         incr i $length
  871.     }
  872.     while {$i >= $length} {
  873.         incr i -$length
  874.     }
  875.     if {[catch {$menu entrycget $i -state} state] == 0} {
  876.         if {[string compare $state "disabled"]} {
  877.         break
  878.         }
  879.     }
  880.     if {$i == $active} {
  881.         return
  882.     }
  883.     incr i $count
  884.     incr quitAfter -1
  885.     }
  886.     $menu activate $i
  887.     tkGenerateMenuSelect $menu
  888.     if {[string equal [$menu type $i] "cascade"]} {
  889.     set cascade [$menu entrycget $i -menu]
  890.     if {[string compare $cascade ""]} {
  891.         # Here we auto-post a cascade.  This is necessary when
  892.         # we traverse left/right in the menubar, but undesirable when
  893.         # we traverse up/down in a menu.
  894.         $menu postcascade $i
  895.         tkMenuFirstEntry $cascade
  896.     }
  897.     }
  898. }
  899.  
  900. # tkMenuFind --
  901. # This procedure searches the entire window hierarchy under w for
  902. # a menubutton that isn't disabled and whose underlined character
  903. # is "char" or an entry in a menubar that isn't disabled and whose
  904. # underlined character is "char".
  905. # It returns the name of that window, if found, or an
  906. # empty string if no matching window was found.  If "char" is an
  907. # empty string then the procedure returns the name of the first
  908. # menubutton found that isn't disabled.
  909. #
  910. # Arguments:
  911. # w -                Name of window where key was typed.
  912. # char -            Underlined character to search for;
  913. #                may be either upper or lower case, and
  914. #                will match either upper or lower case.
  915.  
  916. proc tkMenuFind {w char} {
  917.     global tkPriv
  918.     set char [string tolower $char]
  919.     set windowlist [winfo child $w]
  920.  
  921.     foreach child $windowlist {
  922.     # Don't descend into other toplevels.
  923.         if {[string compare [winfo toplevel [focus]] \
  924.         [winfo toplevel $child]]} {
  925.         continue
  926.     }
  927.     if {[string equal [winfo class $child] "Menu"] && \
  928.         [string equal [$child cget -type] "menubar"]} {
  929.         if {[string equal $char ""]} {
  930.         return $child
  931.         }
  932.         set last [$child index last]
  933.         for {set i [$child cget -tearoff]} {$i <= $last} {incr i} {
  934.         if {[string equal [$child type $i] "separator"]} {
  935.             continue
  936.         }
  937.         set char2 [string index [$child entrycget $i -label] \
  938.             [$child entrycget $i -underline]]
  939.         if {[string equal $char [string tolower $char2]] \
  940.             || [string equal $char ""]} {
  941.             if {[string compare [$child entrycget $i -state] "disabled"]} {
  942.             return $child
  943.             }
  944.         }
  945.         }
  946.     }
  947.     }
  948.  
  949.     foreach child $windowlist {
  950.     # Don't descend into other toplevels.
  951.         if {[string compare [winfo toplevel [focus]] \
  952.         [winfo toplevel $child]]} {
  953.         continue
  954.     }
  955.     switch [winfo class $child] {
  956.         Menubutton {
  957.         set char2 [string index [$child cget -text] \
  958.             [$child cget -underline]]
  959.         if {[string equal $char [string tolower $char2]] \
  960.             || [string equal $char ""]} {
  961.             if {[string compare [$child cget -state] "disabled"]} {
  962.             return $child
  963.             }
  964.         }
  965.         }
  966.  
  967.         default {
  968.         set match [tkMenuFind $child $char]
  969.         if {[string compare $match ""]} {
  970.             return $match
  971.         }
  972.         }
  973.     }
  974.     }
  975.     return {}
  976. }
  977.  
  978. # tkTraverseToMenu --
  979. # This procedure implements keyboard traversal of menus.  Given an
  980. # ASCII character "char", it looks for a menubutton with that character
  981. # underlined.  If one is found, it posts the menubutton's menu
  982. #
  983. # Arguments:
  984. # w -                Window in which the key was typed (selects
  985. #                a toplevel window).
  986. # char -            Character that selects a menu.  The case
  987. #                is ignored.  If an empty string, nothing
  988. #                happens.
  989.  
  990. proc tkTraverseToMenu {w char} {
  991.     global tkPriv
  992.     if {[string equal $char ""]} {
  993.     return
  994.     }
  995.     while {[string equal [winfo class $w] "Menu"]} {
  996.     if {[string compare [$w cget -type] "menubar"] \
  997.         && [string equal $tkPriv(postedMb) ""]} {
  998.         return
  999.     }
  1000.     if {[string equal [$w cget -type] "menubar"]} {
  1001.         break
  1002.     }
  1003.     set w [winfo parent $w]
  1004.     }
  1005.     set w [tkMenuFind [winfo toplevel $w] $char]
  1006.     if {[string compare $w ""]} {
  1007.     if {[string equal [winfo class $w] "Menu"]} {
  1008.         tk_menuSetFocus $w
  1009.         set tkPriv(window) $w
  1010.         tkSaveGrabInfo $w
  1011.         grab -global $w
  1012.         tkTraverseWithinMenu $w $char
  1013.     } else {
  1014.         tkMbPost $w
  1015.         tkMenuFirstEntry [$w cget -menu]
  1016.     }
  1017.     }
  1018. }
  1019.  
  1020. # tkFirstMenu --
  1021. # This procedure traverses to the first menubutton in the toplevel
  1022. # for a given window, and posts that menubutton's menu.
  1023. #
  1024. # Arguments:
  1025. # w -                Name of a window.  Selects which toplevel
  1026. #                to search for menubuttons.
  1027.  
  1028. proc tkFirstMenu w {
  1029.     set w [tkMenuFind [winfo toplevel $w] ""]
  1030.     if {[string compare $w ""]} {
  1031.     if {[string equal [winfo class $w] "Menu"]} {
  1032.         tk_menuSetFocus $w
  1033.         set tkPriv(window) $w
  1034.         tkSaveGrabInfo $w
  1035.         grab -global $w
  1036.         tkMenuFirstEntry $w
  1037.     } else {
  1038.         tkMbPost $w
  1039.         tkMenuFirstEntry [$w cget -menu]
  1040.     }
  1041.     }
  1042. }
  1043.  
  1044. # tkTraverseWithinMenu
  1045. # This procedure implements keyboard traversal within a menu.  It
  1046. # searches for an entry in the menu that has "char" underlined.  If
  1047. # such an entry is found, it is invoked and the menu is unposted.
  1048. #
  1049. # Arguments:
  1050. # w -                The name of the menu widget.
  1051. # char -            The character to look for;  case is
  1052. #                ignored.  If the string is empty then
  1053. #                nothing happens.
  1054.  
  1055. proc tkTraverseWithinMenu {w char} {
  1056.     if {[string equal $char ""]} {
  1057.     return
  1058.     }
  1059.     set char [string tolower $char]
  1060.     set last [$w index last]
  1061.     if {[string equal $last "none"]} {
  1062.     return
  1063.     }
  1064.     for {set i 0} {$i <= $last} {incr i} {
  1065.     if {[catch {set char2 [string index \
  1066.         [$w entrycget $i -label] [$w entrycget $i -underline]]}]} {
  1067.         continue
  1068.     }
  1069.     if {[string equal $char [string tolower $char2]]} {
  1070.         if {[string equal [$w type $i] "cascade"]} {
  1071.         $w activate $i
  1072.         $w postcascade active
  1073.         event generate $w <<MenuSelect>>
  1074.         set m2 [$w entrycget $i -menu]
  1075.         if {[string compare $m2 ""]} {
  1076.             tkMenuFirstEntry $m2
  1077.         }
  1078.         } else {
  1079.         tkMenuUnpost $w
  1080.         uplevel #0 [list $w invoke $i]
  1081.         }
  1082.         return
  1083.     }
  1084.     }
  1085. }
  1086.  
  1087. # tkMenuFirstEntry --
  1088. # Given a menu, this procedure finds the first entry that isn't
  1089. # disabled or a tear-off or separator, and activates that entry.
  1090. # However, if there is already an active entry in the menu (e.g.,
  1091. # because of a previous call to tkPostOverPoint) then the active
  1092. # entry isn't changed.  This procedure also sets the input focus
  1093. # to the menu.
  1094. #
  1095. # Arguments:
  1096. # menu -        Name of the menu window (possibly empty).
  1097.  
  1098. proc tkMenuFirstEntry menu {
  1099.     if {[string equal $menu ""]} {
  1100.     return
  1101.     }
  1102.     tk_menuSetFocus $menu
  1103.     if {[string compare [$menu index active] "none"]} {
  1104.     return
  1105.     }
  1106.     set last [$menu index last]
  1107.     if {[string equal $last "none"]} {
  1108.     return
  1109.     }
  1110.     for {set i 0} {$i <= $last} {incr i} {
  1111.     if {([catch {set state [$menu entrycget $i -state]}] == 0) \
  1112.         && [string compare $state "disabled"] \
  1113.         && [string compare [$menu type $i] "tearoff"]} {
  1114.         $menu activate $i
  1115.         tkGenerateMenuSelect $menu
  1116.         # Only post the cascade if the current menu is a menubar;
  1117.         # otherwise, if the first entry of the cascade is a cascade,
  1118.         # we can get an annoying cascading effect resulting in a bunch of
  1119.         # menus getting posted (bug 676)
  1120.         if {[string equal [$menu type $i] "cascade"] && \
  1121.         [string equal [$menu cget -type] "menubar"]} {
  1122.         set cascade [$menu entrycget $i -menu]
  1123.         if {[string compare $cascade ""]} {
  1124.             $menu postcascade $i
  1125.             tkMenuFirstEntry $cascade
  1126.         }
  1127.         }
  1128.         return
  1129.     }
  1130.     }
  1131. }
  1132.  
  1133. # tkMenuFindName --
  1134. # Given a menu and a text string, return the index of the menu entry
  1135. # that displays the string as its label.  If there is no such entry,
  1136. # return an empty string.  This procedure is tricky because some names
  1137. # like "active" have a special meaning in menu commands, so we can't
  1138. # always use the "index" widget command.
  1139. #
  1140. # Arguments:
  1141. # menu -        Name of the menu widget.
  1142. # s -            String to look for.
  1143.  
  1144. proc tkMenuFindName {menu s} {
  1145.     set i ""
  1146.     if {![regexp {^active$|^last$|^none$|^[0-9]|^@} $s]} {
  1147.     catch {set i [$menu index $s]}
  1148.     return $i
  1149.     }
  1150.     set last [$menu index last]
  1151.     if {[string equal $last "none"]} {
  1152.     return
  1153.     }
  1154.     for {set i 0} {$i <= $last} {incr i} {
  1155.     if {![catch {$menu entrycget $i -label} label]} {
  1156.         if {[string equal $label $s]} {
  1157.         return $i
  1158.         }
  1159.     }
  1160.     }
  1161.     return ""
  1162. }
  1163.  
  1164. # tkPostOverPoint --
  1165. # This procedure posts a given menu such that a given entry in the
  1166. # menu is centered over a given point in the root window.  It also
  1167. # activates the given entry.
  1168. #
  1169. # Arguments:
  1170. # menu -        Menu to post.
  1171. # x, y -        Root coordinates of point.
  1172. # entry -        Index of entry within menu to center over (x,y).
  1173. #            If omitted or specified as {}, then the menu's
  1174. #            upper-left corner goes at (x,y).
  1175.  
  1176. proc tkPostOverPoint {menu x y {entry {}}}  {
  1177.     global tcl_platform
  1178.     
  1179.     if {[string compare $entry {}]} {
  1180.     if {$entry == [$menu index last]} {
  1181.         incr y [expr {-([$menu yposition $entry] \
  1182.             + [winfo reqheight $menu])/2}]
  1183.     } else {
  1184.         incr y [expr {-([$menu yposition $entry] \
  1185.             + [$menu yposition [expr {$entry+1}]])/2}]
  1186.     }
  1187.     incr x [expr {-[winfo reqwidth $menu]/2}]
  1188.     }
  1189.     $menu post $x $y
  1190.     if {[string compare $entry {}] \
  1191.         && [string compare [$menu entrycget $entry -state] "disabled"]} {
  1192.     $menu activate $entry
  1193.     tkGenerateMenuSelect $menu
  1194.     }
  1195. }
  1196.  
  1197. # tkSaveGrabInfo --
  1198. # Sets the variables tkPriv(oldGrab) and tkPriv(grabStatus) to record
  1199. # the state of any existing grab on the w's display.
  1200. #
  1201. # Arguments:
  1202. # w -            Name of a window;  used to select the display
  1203. #            whose grab information is to be recorded.
  1204.  
  1205. proc tkSaveGrabInfo w {
  1206.     global tkPriv
  1207.     set tkPriv(oldGrab) [grab current $w]
  1208.     if {[string compare $tkPriv(oldGrab) ""]} {
  1209.     set tkPriv(grabStatus) [grab status $tkPriv(oldGrab)]
  1210.     }
  1211. }
  1212.  
  1213. # tkRestoreOldGrab --
  1214. # Restores the grab to what it was before TkSaveGrabInfo was called.
  1215. #
  1216.  
  1217. proc tkRestoreOldGrab {} {
  1218.     global tkPriv
  1219.  
  1220.     if {[string compare $tkPriv(oldGrab) ""]} {
  1221.  
  1222.         # Be careful restoring the old grab, since it's window may not
  1223.     # be visible anymore.
  1224.  
  1225.     catch {
  1226.           if {[string equal $tkPriv(grabStatus) "global"]} {
  1227.         grab set -global $tkPriv(oldGrab)
  1228.         } else {
  1229.         grab set $tkPriv(oldGrab)
  1230.         }
  1231.     }
  1232.     set tkPriv(oldGrab) ""
  1233.     }
  1234. }
  1235.  
  1236. proc tk_menuSetFocus {menu} {
  1237.     global tkPriv
  1238.     if {![info exists tkPriv(focus)] || [string equal $tkPriv(focus) {}]} {
  1239.     set tkPriv(focus) [focus]
  1240.     }
  1241.     focus $menu
  1242. }
  1243.     
  1244. proc tkGenerateMenuSelect {menu} {
  1245.     global tkPriv
  1246.  
  1247.     if {[string equal $tkPriv(activeMenu) $menu] \
  1248.           && [string equal $tkPriv(activeItem) [$menu index active]]} {
  1249.     return
  1250.     }
  1251.  
  1252.     set tkPriv(activeMenu) $menu
  1253.     set tkPriv(activeItem) [$menu index active]
  1254.     event generate $menu <<MenuSelect>>
  1255. }
  1256.  
  1257. # tk_popup --
  1258. # This procedure pops up a menu and sets things up for traversing
  1259. # the menu and its submenus.
  1260. #
  1261. # Arguments:
  1262. # menu -        Name of the menu to be popped up.
  1263. # x, y -        Root coordinates at which to pop up the
  1264. #            menu.
  1265. # entry -        Index of a menu entry to center over (x,y).
  1266. #            If omitted or specified as {}, then menu's
  1267. #            upper-left corner goes at (x,y).
  1268.  
  1269. proc tk_popup {menu x y {entry {}}} {
  1270.     global tkPriv
  1271.     global tcl_platform
  1272.     if {[string compare $tkPriv(popup) ""] \
  1273.         || [string compare $tkPriv(postedMb) ""]} {
  1274.     tkMenuUnpost {}
  1275.     }
  1276.     tkPostOverPoint $menu $x $y $entry
  1277.     if {[string equal $tcl_platform(platform) "unix"] \
  1278.         && [winfo viewable $menu]} {
  1279.         tkSaveGrabInfo $menu
  1280.     grab -global $menu
  1281.     set tkPriv(popup) $menu
  1282.     tk_menuSetFocus $menu
  1283.     }
  1284. }
  1285.