home *** CD-ROM | disk | FTP | other *** search
/ PCNET 2006 September - Disc 1 / PCNET_CD_2006_09.iso / linux / puppy-barebones-2.01r2.iso / pup_201.sfs / usr / lib / tk8.5 / menu.tcl < prev    next >
Encoding:
Text File  |  2006-06-17  |  35.3 KB  |  1,300 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.23 2005/10/16 02:36:45 hobbs 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 tk::Priv 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 tk::Priv(oldGrab):  if
  24. #            tk::Priv(oldGrab) is non-empty, then tk::Priv(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. #    tk::Priv(postedMb) identifies the posted menubutton.
  66. # 2. As a torn-off menu copied from some other menu.  In this style
  67. #    tk::Priv(postedMb) is empty, and menu's type is "tearoff".
  68. # 3. As an option menu, triggered from an option menubutton.  In this
  69. #    style tk::Priv(postedMb) identifies the posted menubutton.
  70. # 4. As a popup menu.  In this style tk::Priv(postedMb) is empty and
  71. #    the top-level menu's type is "normal".
  72. # 5. As a pulldown from a menubar. The variable tk::Priv(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.     tk::MbEnter %W
  88. }
  89. bind Menubutton <Leave> {
  90.     tk::MbLeave %W
  91. }
  92. bind Menubutton <1> {
  93.     if {$tk::Priv(inMenubutton) ne ""} {
  94.     tk::MbPost $tk::Priv(inMenubutton) %X %Y
  95.     }
  96. }
  97. bind Menubutton <Motion> {
  98.     tk::MbMotion %W up %X %Y
  99. }
  100. bind Menubutton <B1-Motion> {
  101.     tk::MbMotion %W down %X %Y
  102. }
  103. bind Menubutton <ButtonRelease-1> {
  104.     tk::MbButtonUp %W
  105. }
  106. bind Menubutton <space> {
  107.     tk::MbPost %W
  108.     tk::MenuFirstEntry [%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 tk::Priv(window) %W
  122.     if {[%W cget -type] eq "tearoff"} {
  123.     if {"%m" ne "NotifyUngrab"} {
  124.         if {[tk windowingsystem] eq "x11"} {
  125.         tk_menuSetFocus %W
  126.         }
  127.     }
  128.     }
  129.     tk::MenuMotion %W %x %y %s
  130. }
  131.  
  132. bind Menu <Leave> {
  133.     tk::MenuLeave %W %X %Y %s
  134. }
  135. bind Menu <Motion> {
  136.     tk::MenuMotion %W %x %y %s
  137. }
  138. bind Menu <ButtonPress> {
  139.     tk::MenuButtonDown %W
  140. }
  141. bind Menu <ButtonRelease> {
  142.    tk::MenuInvoke %W 1
  143. }
  144. bind Menu <space> {
  145.     tk::MenuInvoke %W 0
  146. }
  147. bind Menu <Return> {
  148.     tk::MenuInvoke %W 0
  149. }
  150. bind Menu <Escape> {
  151.     tk::MenuEscape %W
  152. }
  153. bind Menu <Left> {
  154.     tk::MenuLeftArrow %W
  155. }
  156. bind Menu <Right> {
  157.     tk::MenuRightArrow %W
  158. }
  159. bind Menu <Up> {
  160.     tk::MenuUpArrow %W
  161. }
  162. bind Menu <Down> {
  163.     tk::MenuDownArrow %W
  164. }
  165. bind Menu <KeyPress> {
  166.     tk::TraverseWithinMenu %W %A
  167. }
  168.  
  169. # The following bindings apply to all windows, and are used to
  170. # implement keyboard menu traversal.
  171.  
  172. if {[tk windowingsystem] eq "x11"} {
  173.     bind all <Alt-KeyPress> {
  174.     tk::TraverseToMenu %W %A
  175.     }
  176.  
  177.     bind all <F10> {
  178.     tk::FirstMenu %W
  179.     }
  180. } else {
  181.     bind Menubutton <Alt-KeyPress> {
  182.     tk::TraverseToMenu %W %A
  183.     }
  184.  
  185.     bind Menubutton <F10> {
  186.     tk::FirstMenu %W
  187.     }
  188. }
  189.  
  190. # ::tk::MbEnter --
  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 ::tk::MbB1Enter is invoked if the button is down.
  195. #
  196. # Arguments:
  197. # w -            The  name of the widget.
  198.  
  199. proc ::tk::MbEnter w {
  200.     variable ::tk::Priv
  201.  
  202.     if {$Priv(inMenubutton) ne ""} {
  203.     MbLeave $Priv(inMenubutton)
  204.     }
  205.     set Priv(inMenubutton) $w
  206.     if {[$w cget -state] ne "disabled"} {
  207.     $w configure -state active
  208.     }
  209. }
  210.  
  211. # ::tk::MbLeave --
  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 ::tk::MbLeave w {
  219.     variable ::tk::Priv
  220.  
  221.     set Priv(inMenubutton) {}
  222.     if {![winfo exists $w]} {
  223.     return
  224.     }
  225.     if {[$w cget -state] eq "active"} {
  226.     $w configure -state normal
  227.     }
  228. }
  229.  
  230. # ::tk::MbPost --
  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 ::tk::MbPost {w {x {}} {y {}}} {
  243.     global errorInfo
  244.     variable ::tk::Priv
  245.     global tcl_platform
  246.  
  247.     if {[$w cget -state] eq "disabled" || $w eq $Priv(postedMb)} {
  248.     return
  249.     }
  250.     set menu [$w cget -menu]
  251.     if {$menu eq ""} {
  252.     return
  253.     }
  254.     set tearoff [expr {[tk windowingsystem] eq "x11" \
  255.         || [$menu cget -type] eq "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 $Priv(postedMb)
  260.     if {$cur ne ""} {
  261.     MenuUnpost {}
  262.     }
  263.     set Priv(cursor) [$w cget -cursor]
  264.     set Priv(relief) [$w cget -relief]
  265.     $w configure -cursor arrow
  266.     $w configure -relief raised
  267.  
  268.     set Priv(postedMb) $w
  269.     set Priv(focus) [focus]
  270.     $menu activate none
  271.     GenerateMenuSelect $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.         # if we go offscreen to the top, show as 'below'
  284.         if {$y < 0} {
  285.             set y [expr {[winfo rooty $w] + [winfo height $w]}]
  286.         }
  287.         PostOverPoint $menu $x $y
  288.             }
  289.             below {
  290.                 set x [winfo rootx $w]
  291.                 set y [expr {[winfo rooty $w] + [winfo height $w]}]
  292.         # if we go offscreen to the bottom, show as 'above'
  293.         set mh [winfo reqheight $menu]
  294.         if {($y + $mh) > [winfo screenheight $w]} {
  295.             set y [expr {[winfo rooty $w] - $mh}]
  296.         }
  297.         PostOverPoint $menu $x $y
  298.             }
  299.             left {
  300.                 set x [expr {[winfo rootx $w] - [winfo reqwidth $menu]}]
  301.                 set y [expr {(2 * [winfo rooty $w] + [winfo height $w]) / 2}]
  302.                 set entry [MenuFindName $menu [$w cget -text]]
  303.                 if {[$w cget -indicatoron]} {
  304.             if {$entry == [$menu index last]} {
  305.                 incr y [expr {-([$menu yposition $entry] \
  306.                     + [winfo reqheight $menu])/2}]
  307.             } else {
  308.                 incr y [expr {-([$menu yposition $entry] \
  309.                     + [$menu yposition [expr {$entry+1}]])/2}]
  310.             }
  311.                 }
  312.         PostOverPoint $menu $x $y
  313.         if {$entry ne "" \
  314.             && [$menu entrycget $entry -state] ne "disabled"} {
  315.                     $menu activate $entry
  316.             GenerateMenuSelect $menu
  317.                 }
  318.             }
  319.             right {
  320.                 set x [expr {[winfo rootx $w] + [winfo width $w]}]
  321.                 set y [expr {(2 * [winfo rooty $w] + [winfo height $w]) / 2}]
  322.                 set entry [MenuFindName $menu [$w cget -text]]
  323.                 if {[$w cget -indicatoron]} {
  324.             if {$entry == [$menu index last]} {
  325.                 incr y [expr {-([$menu yposition $entry] \
  326.                     + [winfo reqheight $menu])/2}]
  327.             } else {
  328.                 incr y [expr {-([$menu yposition $entry] \
  329.                     + [$menu yposition [expr {$entry+1}]])/2}]
  330.             }
  331.                 }
  332.         PostOverPoint $menu $x $y
  333.         if {$entry ne "" \
  334.             && [$menu entrycget $entry -state] ne "disabled"} {
  335.                     $menu activate $entry
  336.             GenerateMenuSelect $menu
  337.                 }
  338.             }
  339.             default {
  340.                 if {[$w cget -indicatoron]} {
  341.             if {$y eq ""} {
  342.             set x [expr {[winfo rootx $w] + [winfo width $w]/2}]
  343.             set y [expr {[winfo rooty $w] + [winfo height $w]/2}]
  344.                 }
  345.                 PostOverPoint $menu $x $y [MenuFindName $menu [$w cget -text]]
  346.         } else {
  347.             PostOverPoint $menu [winfo rootx $w] [expr {[winfo rooty $w]+[winfo height $w]}]
  348.                 }
  349.             }
  350.     }
  351.     } msg]} {
  352.     # Error posting menu (e.g. bogus -postcommand). Unpost it and
  353.     # reflect the error.
  354.     
  355.     set savedInfo $errorInfo
  356.     MenuUnpost {}
  357.     error $msg $savedInfo
  358.  
  359.     }
  360.  
  361.     set Priv(tearoff) $tearoff
  362.     if {$tearoff != 0} {
  363.         focus $menu
  364.     if {[winfo viewable $w]} {
  365.         SaveGrabInfo $w
  366.         grab -global $w
  367.     }
  368.     }
  369. }
  370.  
  371. # ::tk::MenuUnpost --
  372. # This procedure unposts a given menu, plus all of its ancestors up
  373. # to (and including) a menubutton, if any.  It also restores various
  374. # values to what they were before the menu was posted, and releases
  375. # a grab if there's a menubutton involved.  Special notes:
  376. # 1. It's important to unpost all menus before releasing the grab, so
  377. #    that any Enter-Leave events (e.g. from menu back to main
  378. #    application) have mode NotifyGrab.
  379. # 2. Be sure to enclose various groups of commands in "catch" so that
  380. #    the procedure will complete even if the menubutton or the menu
  381. #    or the grab window has been deleted.
  382. #
  383. # Arguments:
  384. # menu -        Name of a menu to unpost.  Ignored if there
  385. #            is a posted menubutton.
  386.  
  387. proc ::tk::MenuUnpost menu {
  388.     global tcl_platform
  389.     variable ::tk::Priv
  390.     set mb $Priv(postedMb)
  391.  
  392.     # Restore focus right away (otherwise X will take focus away when
  393.     # the menu is unmapped and under some window managers (e.g. olvwm)
  394.     # we'll lose the focus completely).
  395.  
  396.     catch {focus $Priv(focus)}
  397.     set Priv(focus) ""
  398.  
  399.     # Unpost menu(s) and restore some stuff that's dependent on
  400.     # what was posted.
  401.  
  402.     catch {
  403.     if {$mb ne ""} {
  404.         set menu [$mb cget -menu]
  405.         $menu unpost
  406.         set Priv(postedMb) {}
  407.         $mb configure -cursor $Priv(cursor)
  408.         $mb configure -relief $Priv(relief)
  409.     } elseif {$Priv(popup) ne ""} {
  410.         $Priv(popup) unpost
  411.         set Priv(popup) {}
  412.     } elseif {[$menu cget -type] ne "menubar" \
  413.         && [$menu cget -type] ne "tearoff"} {
  414.         # We're in a cascaded sub-menu from a torn-off menu or popup.
  415.         # Unpost all the menus up to the toplevel one (but not
  416.         # including the top-level torn-off one) and deactivate the
  417.         # top-level torn off menu if there is one.
  418.  
  419.         while {1} {
  420.         set parent [winfo parent $menu]
  421.         if {[winfo class $parent] ne "Menu" \
  422.             || ![winfo ismapped $parent]} {
  423.             break
  424.         }
  425.         $parent activate none
  426.         $parent postcascade none
  427.         GenerateMenuSelect $parent
  428.         set type [$parent cget -type]
  429.         if {$type eq "menubar" || $type eq "tearoff"} {
  430.             break
  431.         }
  432.         set menu $parent
  433.         }
  434.         if {[$menu cget -type] ne "menubar"} {
  435.         $menu unpost
  436.         }
  437.     }
  438.     }
  439.  
  440.     if {($Priv(tearoff) != 0) || $Priv(menuBar) ne ""} {
  441.         # Release grab, if any, and restore the previous grab, if there
  442.         # was one.
  443.     if {$menu ne ""} {
  444.         set grab [grab current $menu]
  445.         if {$grab ne ""} {
  446.         grab release $grab
  447.         }
  448.     }
  449.     RestoreOldGrab
  450.     if {$Priv(menuBar) ne ""} {
  451.         $Priv(menuBar) configure -cursor $Priv(cursor)
  452.         set Priv(menuBar) {}
  453.     }
  454.     if {[tk windowingsystem] ne "x11"} {
  455.         set Priv(tearoff) 0
  456.     }
  457.     }
  458. }
  459.  
  460. # ::tk::MbMotion --
  461. # This procedure handles mouse motion events inside menubuttons, and
  462. # also outside menubuttons when a menubutton has a grab (e.g. when a
  463. # menu selection operation is in progress).
  464. #
  465. # Arguments:
  466. # w -            The name of the menubutton widget.
  467. # upDown -         "down" means button 1 is pressed, "up" means
  468. #            it isn't.
  469. # rootx, rooty -    Coordinates of mouse, in (virtual?) root window.
  470.  
  471. proc ::tk::MbMotion {w upDown rootx rooty} {
  472.     variable ::tk::Priv
  473.  
  474.     if {$Priv(inMenubutton) eq $w} {
  475.     return
  476.     }
  477.     set new [winfo containing $rootx $rooty]
  478.     if {$new ne $Priv(inMenubutton) \
  479.         && ($new eq "" || [winfo toplevel $new] eq [winfo toplevel $w])} {
  480.     if {$Priv(inMenubutton) ne ""} {
  481.         MbLeave $Priv(inMenubutton)
  482.     }
  483.     if {$new ne "" \
  484.         && [winfo class $new] eq "Menubutton" \
  485.         && ([$new cget -indicatoron] == 0) \
  486.         && ([$w cget -indicatoron] == 0)} {
  487.         if {$upDown eq "down"} {
  488.         MbPost $new $rootx $rooty
  489.         } else {
  490.         MbEnter $new
  491.         }
  492.     }
  493.     }
  494. }
  495.  
  496. # ::tk::MbButtonUp --
  497. # This procedure is invoked to handle button 1 releases for menubuttons.
  498. # If the release happens inside the menubutton then leave its menu
  499. # posted with element 0 activated.  Otherwise, unpost the menu.
  500. #
  501. # Arguments:
  502. # w -            The name of the menubutton widget.
  503.  
  504. proc ::tk::MbButtonUp w {
  505.     variable ::tk::Priv
  506.     global tcl_platform
  507.  
  508.     set menu [$w cget -menu]
  509.     set tearoff [expr {[tk windowingsystem] eq "x11" || \
  510.         ($menu ne "" && [$menu cget -type] eq "tearoff")}]
  511.     if {($tearoff != 0) && $Priv(postedMb) eq $w \
  512.         && $Priv(inMenubutton) eq $w} {
  513.     MenuFirstEntry [$Priv(postedMb) cget -menu]
  514.     } else {
  515.     MenuUnpost {}
  516.     }
  517. }
  518.  
  519. # ::tk::MenuMotion --
  520. # This procedure is called to handle mouse motion events for menus.
  521. # It does two things.  First, it resets the active element in the
  522. # menu, if the mouse is over the menu.  Second, if a mouse button
  523. # is down, it posts and unposts cascade entries to match the mouse
  524. # position.
  525. #
  526. # Arguments:
  527. # menu -        The menu window.
  528. # x -            The x position of the mouse.
  529. # y -            The y position of the mouse.
  530. # state -        Modifier state (tells whether buttons are down).
  531.  
  532. proc ::tk::MenuMotion {menu x y state} {
  533.     variable ::tk::Priv
  534.     if {$menu eq $Priv(window)} {
  535.     if {[$menu cget -type] eq "menubar"} {
  536.         if {[info exists Priv(focus)] && $menu ne $Priv(focus)} {
  537.         $menu activate @$x,$y
  538.         GenerateMenuSelect $menu
  539.         }
  540.     } else {
  541.         $menu activate @$x,$y
  542.         GenerateMenuSelect $menu
  543.     }
  544.     }
  545.     if {($state & 0x1f00) != 0} {
  546.     $menu postcascade active
  547.     }
  548. }
  549.  
  550. # ::tk::MenuButtonDown --
  551. # Handles button presses in menus.  There are a couple of tricky things
  552. # here:
  553. # 1. Change the posted cascade entry (if any) to match the mouse position.
  554. # 2. If there is a posted menubutton, must grab to the menubutton;  this
  555. #    overrrides the implicit grab on button press, so that the menu
  556. #    button can track mouse motions over other menubuttons and change
  557. #    the posted menu.
  558. # 3. If there's no posted menubutton (e.g. because we're a torn-off menu
  559. #    or one of its descendants) must grab to the top-level menu so that
  560. #    we can track mouse motions across the entire menu hierarchy.
  561. #
  562. # Arguments:
  563. # menu -        The menu window.
  564.  
  565. proc ::tk::MenuButtonDown menu {
  566.     variable ::tk::Priv
  567.     global tcl_platform
  568.  
  569.     if {![winfo viewable $menu]} {
  570.         return
  571.     }
  572.     $menu postcascade active
  573.     if {$Priv(postedMb) ne "" && [winfo viewable $Priv(postedMb)]} {
  574.     grab -global $Priv(postedMb)
  575.     } else {
  576.     while {[$menu cget -type] eq "normal" \
  577.         && [winfo class [winfo parent $menu]] eq "Menu" \
  578.         && [winfo ismapped [winfo parent $menu]]} {
  579.         set menu [winfo parent $menu]
  580.     }
  581.  
  582.     if {$Priv(menuBar) eq {}} {
  583.         set Priv(menuBar) $menu
  584.         set Priv(cursor) [$menu cget -cursor]
  585.         $menu configure -cursor arrow
  586.         }
  587.  
  588.     # Don't update grab information if the grab window isn't changing.
  589.     # Otherwise, we'll get an error when we unpost the menus and
  590.     # restore the grab, since the old grab window will not be viewable
  591.     # anymore.
  592.  
  593.     if {$menu ne [grab current $menu]} {
  594.         SaveGrabInfo $menu
  595.     }
  596.  
  597.     # Must re-grab even if the grab window hasn't changed, in order
  598.     # to release the implicit grab from the button press.
  599.  
  600.     if {[tk windowingsystem] eq "x11"} {
  601.         grab -global $menu
  602.     }
  603.     }
  604. }
  605.  
  606. # ::tk::MenuLeave --
  607. # This procedure is invoked to handle Leave events for a menu.  It
  608. # deactivates everything unless the active element is a cascade element
  609. # and the mouse is now over the submenu.
  610. #
  611. # Arguments:
  612. # menu -        The menu window.
  613. # rootx, rooty -    Root coordinates of mouse.
  614. # state -        Modifier state.
  615.  
  616. proc ::tk::MenuLeave {menu rootx rooty state} {
  617.     variable ::tk::Priv
  618.     set Priv(window) {}
  619.     if {[$menu index active] eq "none"} {
  620.     return
  621.     }
  622.     if {[$menu type active] eq "cascade" \
  623.         && [winfo containing $rootx $rooty] eq \
  624.         [$menu entrycget active -menu]} {
  625.     return
  626.     }
  627.     $menu activate none
  628.     GenerateMenuSelect $menu
  629. }
  630.  
  631. # ::tk::MenuInvoke --
  632. # This procedure is invoked when button 1 is released over a menu.
  633. # It invokes the appropriate menu action and unposts the menu if
  634. # it came from a menubutton.
  635. #
  636. # Arguments:
  637. # w -            Name of the menu widget.
  638. # buttonRelease -    1 means this procedure is called because of
  639. #            a button release;  0 means because of keystroke.
  640.  
  641. proc ::tk::MenuInvoke {w buttonRelease} {
  642.     variable ::tk::Priv
  643.  
  644.     if {$buttonRelease && $Priv(window) eq ""} {
  645.     # Mouse was pressed over a menu without a menu button, then
  646.     # dragged off the menu (possibly with a cascade posted) and
  647.     # released.  Unpost everything and quit.
  648.  
  649.     $w postcascade none
  650.     $w activate none
  651.     event generate $w <<MenuSelect>>
  652.     MenuUnpost $w
  653.     return
  654.     }
  655.     if {[$w type active] eq "cascade"} {
  656.     $w postcascade active
  657.     set menu [$w entrycget active -menu]
  658.     MenuFirstEntry $menu
  659.     } elseif {[$w type active] eq "tearoff"} {
  660.     ::tk::TearOffMenu $w
  661.     MenuUnpost $w
  662.     } elseif {[$w cget -type] eq "menubar"} {
  663.     $w postcascade none
  664.     set active [$w index active]
  665.     set isCascade [string equal [$w type $active] "cascade"]
  666.  
  667.     # Only de-activate the active item if it's a cascade; this prevents
  668.     # the annoying "activation flicker" you otherwise get with 
  669.     # checkbuttons/commands/etc. on menubars
  670.  
  671.     if { $isCascade } {
  672.         $w activate none
  673.         event generate $w <<MenuSelect>>
  674.     }
  675.  
  676.     MenuUnpost $w
  677.  
  678.     # If the active item is not a cascade, invoke it.  This enables
  679.     # the use of checkbuttons/commands/etc. on menubars (which is legal,
  680.     # but not recommended)
  681.  
  682.     if { !$isCascade } {
  683.         uplevel #0 [list $w invoke $active]
  684.     }
  685.     } else {
  686.     set active [$w index active]
  687.     if {$Priv(popup) eq "" || $active ne "none"} {
  688.         MenuUnpost $w
  689.     }
  690.     uplevel #0 [list $w invoke active]
  691.     }
  692. }
  693.  
  694. # ::tk::MenuEscape --
  695. # This procedure is invoked for the Cancel (or Escape) key.  It unposts
  696. # the given menu and, if it is the top-level menu for a menu button,
  697. # unposts the menu button as well.
  698. #
  699. # Arguments:
  700. # menu -        Name of the menu window.
  701.  
  702. proc ::tk::MenuEscape menu {
  703.     set parent [winfo parent $menu]
  704.     if {[winfo class $parent] ne "Menu"} {
  705.     MenuUnpost $menu
  706.     } elseif {[$parent cget -type] eq "menubar"} {
  707.     MenuUnpost $menu
  708.     RestoreOldGrab
  709.     } else {
  710.     MenuNextMenu $menu left
  711.     }
  712. }
  713.  
  714. # The following routines handle arrow keys. Arrow keys behave
  715. # differently depending on whether the menu is a menu bar or not.
  716.  
  717. proc ::tk::MenuUpArrow {menu} {
  718.     if {[$menu cget -type] eq "menubar"} {
  719.     MenuNextMenu $menu left
  720.     } else {
  721.     MenuNextEntry $menu -1
  722.     }
  723. }
  724.  
  725. proc ::tk::MenuDownArrow {menu} {
  726.     if {[$menu cget -type] eq "menubar"} {
  727.     MenuNextMenu $menu right
  728.     } else {
  729.     MenuNextEntry $menu 1
  730.     }
  731. }
  732.  
  733. proc ::tk::MenuLeftArrow {menu} {
  734.     if {[$menu cget -type] eq "menubar"} {
  735.     MenuNextEntry $menu -1
  736.     } else {
  737.     MenuNextMenu $menu left
  738.     }
  739. }
  740.  
  741. proc ::tk::MenuRightArrow {menu} {
  742.     if {[$menu cget -type] eq "menubar"} {
  743.     MenuNextEntry $menu 1
  744.     } else {
  745.     MenuNextMenu $menu right
  746.     }
  747. }
  748.  
  749. # ::tk::MenuNextMenu --
  750. # This procedure is invoked to handle "left" and "right" traversal
  751. # motions in menus.  It traverses to the next menu in a menu bar,
  752. # or into or out of a cascaded menu.
  753. #
  754. # Arguments:
  755. # menu -        The menu that received the keyboard
  756. #            event.
  757. # direction -        Direction in which to move: "left" or "right"
  758.  
  759. proc ::tk::MenuNextMenu {menu direction} {
  760.     variable ::tk::Priv
  761.  
  762.     # First handle traversals into and out of cascaded menus.
  763.  
  764.     if {$direction eq "right"} {
  765.     set count 1
  766.     set parent [winfo parent $menu]
  767.     set class [winfo class $parent]
  768.     if {[$menu type active] eq "cascade"} {
  769.         $menu postcascade active
  770.         set m2 [$menu entrycget active -menu]
  771.         if {$m2 ne ""} {
  772.         MenuFirstEntry $m2
  773.         }
  774.         return
  775.     } else {
  776.         set parent [winfo parent $menu]
  777.         while {$parent ne "."} {
  778.         if {[winfo class $parent] eq "Menu" \
  779.             && [$parent cget -type] eq "menubar"} {
  780.             tk_menuSetFocus $parent
  781.             MenuNextEntry $parent 1
  782.             return
  783.         }
  784.         set parent [winfo parent $parent]
  785.         }
  786.     }
  787.     } else {
  788.     set count -1
  789.     set m2 [winfo parent $menu]
  790.     if {[winfo class $m2] eq "Menu"} {
  791.         $menu activate none
  792.         GenerateMenuSelect $menu
  793.         tk_menuSetFocus $m2
  794.  
  795.         $m2 postcascade none
  796.  
  797.         if {[$m2 cget -type] ne "menubar"} {
  798.         return
  799.         }
  800.     }
  801.     }
  802.  
  803.     # Can't traverse into or out of a cascaded menu. Go to the next
  804.     # or previous menubutton, if that makes sense.
  805.  
  806.     set m2 [winfo parent $menu]
  807.     if {[winfo class $m2] eq "Menu" && [$m2 cget -type] eq "menubar"} {
  808.     tk_menuSetFocus $m2
  809.     MenuNextEntry $m2 -1
  810.     return
  811.     }
  812.  
  813.     set w $Priv(postedMb)
  814.     if {$w eq ""} {
  815.     return
  816.     }
  817.     set buttons [winfo children [winfo parent $w]]
  818.     set length [llength $buttons]
  819.     set i [expr {[lsearch -exact $buttons $w] + $count}]
  820.     while {1} {
  821.     while {$i < 0} {
  822.         incr i $length
  823.     }
  824.     while {$i >= $length} {
  825.         incr i -$length
  826.     }
  827.     set mb [lindex $buttons $i]
  828.     if {[winfo class $mb] eq "Menubutton" \
  829.         && [$mb cget -state] ne "disabled" \
  830.         && [$mb cget -menu] ne "" \
  831.         && [[$mb cget -menu] index last] ne "none"} {
  832.         break
  833.     }
  834.     if {$mb eq $w} {
  835.         return
  836.     }
  837.     incr i $count
  838.     }
  839.     MbPost $mb
  840.     MenuFirstEntry [$mb cget -menu]
  841. }
  842.  
  843. # ::tk::MenuNextEntry --
  844. # Activate the next higher or lower entry in the posted menu,
  845. # wrapping around at the ends.  Disabled entries are skipped.
  846. #
  847. # Arguments:
  848. # menu -            Menu window that received the keystroke.
  849. # count -            1 means go to the next lower entry,
  850. #                -1 means go to the next higher entry.
  851.  
  852. proc ::tk::MenuNextEntry {menu count} {
  853.     if {[$menu index last] eq "none"} {
  854.     return
  855.     }
  856.     set length [expr {[$menu index last]+1}]
  857.     set quitAfter $length
  858.     set active [$menu index active]
  859.     if {$active eq "none"} {
  860.     set i 0
  861.     } else {
  862.     set i [expr {$active + $count}]
  863.     }
  864.     while {1} {
  865.     if {$quitAfter <= 0} {
  866.         # We've tried every entry in the menu.  Either there are
  867.         # none, or they're all disabled.  Just give up.
  868.  
  869.         return
  870.     }
  871.     while {$i < 0} {
  872.         incr i $length
  873.     }
  874.     while {$i >= $length} {
  875.         incr i -$length
  876.     }
  877.     if {[catch {$menu entrycget $i -state} state] == 0} {
  878.         if {$state ne "disabled" && \
  879.             ($i!=0 || [$menu cget -type] ne "tearoff" \
  880.             || [$menu type 0] ne "tearoff")} {
  881.         break
  882.         }
  883.     }
  884.     if {$i == $active} {
  885.         return
  886.     }
  887.     incr i $count
  888.     incr quitAfter -1
  889.     }
  890.     $menu activate $i
  891.     GenerateMenuSelect $menu
  892.  
  893.     if {[$menu type $i] eq "cascade" && [$menu cget -type] eq "menubar"} {
  894.     set cascade [$menu entrycget $i -menu]
  895.     if {$cascade ne ""} {
  896.         # Here we auto-post a cascade.  This is necessary when
  897.         # we traverse left/right in the menubar, but undesirable when
  898.         # we traverse up/down in a menu.
  899.         $menu postcascade $i
  900.         MenuFirstEntry $cascade
  901.     }
  902.     }
  903. }
  904.  
  905. # ::tk::MenuFind --
  906. # This procedure searches the entire window hierarchy under w for
  907. # a menubutton that isn't disabled and whose underlined character
  908. # is "char" or an entry in a menubar that isn't disabled and whose
  909. # underlined character is "char".
  910. # It returns the name of that window, if found, or an
  911. # empty string if no matching window was found.  If "char" is an
  912. # empty string then the procedure returns the name of the first
  913. # menubutton found that isn't disabled.
  914. #
  915. # Arguments:
  916. # w -                Name of window where key was typed.
  917. # char -            Underlined character to search for;
  918. #                may be either upper or lower case, and
  919. #                will match either upper or lower case.
  920.  
  921. proc ::tk::MenuFind {w char} {
  922.     set char [string tolower $char]
  923.     set windowlist [winfo child $w]
  924.  
  925.     foreach child $windowlist {
  926.     # Don't descend into other toplevels.
  927.         if {[winfo toplevel $w] ne [winfo toplevel $child]} {
  928.         continue
  929.     }
  930.     if {[winfo class $child] eq "Menu" && \
  931.         [$child cget -type] eq "menubar"} {
  932.         if {$char eq ""} {
  933.         return $child
  934.         }
  935.         set last [$child index last]
  936.         for {set i [$child cget -tearoff]} {$i <= $last} {incr i} {
  937.         if {[$child type $i] eq "separator"} {
  938.             continue
  939.         }
  940.         set char2 [string index [$child entrycget $i -label] \
  941.             [$child entrycget $i -underline]]
  942.         if {$char eq [string tolower $char2] || $char eq ""} {
  943.             if {[$child entrycget $i -state] ne "disabled"} {
  944.             return $child
  945.             }
  946.         }
  947.         }
  948.     }
  949.     }
  950.  
  951.     foreach child $windowlist {
  952.     # Don't descend into other toplevels.
  953.         if {[winfo toplevel $w] ne [winfo toplevel $child]} {
  954.         continue
  955.     }
  956.     switch -- [winfo class $child] {
  957.         Menubutton {
  958.         set char2 [string index [$child cget -text] \
  959.             [$child cget -underline]]
  960.         if {$char eq [string tolower $char2] || $char eq ""} {
  961.             if {[$child cget -state] ne "disabled"} {
  962.             return $child
  963.             }
  964.         }
  965.         }
  966.  
  967.         default {
  968.         set match [MenuFind $child $char]
  969.         if {$match ne ""} {
  970.             return $match
  971.         }
  972.         }
  973.     }
  974.     }
  975.     return {}
  976. }
  977.  
  978. # ::tk::TraverseToMenu --
  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 ::tk::TraverseToMenu {w char} {
  991.     variable ::tk::Priv
  992.     if {$char eq ""} {
  993.     return
  994.     }
  995.     while {[winfo class $w] eq "Menu"} {
  996.     if {[$w cget -type] ne "menubar" && $Priv(postedMb) eq ""} {
  997.         return
  998.     }
  999.     if {[$w cget -type] eq "menubar"} {
  1000.         break
  1001.     }
  1002.     set w [winfo parent $w]
  1003.     }
  1004.     set w [MenuFind [winfo toplevel $w] $char]
  1005.     if {$w ne ""} {
  1006.     if {[winfo class $w] eq "Menu"} {
  1007.         tk_menuSetFocus $w
  1008.         set Priv(window) $w
  1009.         SaveGrabInfo $w
  1010.         grab -global $w
  1011.         TraverseWithinMenu $w $char
  1012.     } else {
  1013.         MbPost $w
  1014.         MenuFirstEntry [$w cget -menu]
  1015.     }
  1016.     }
  1017. }
  1018.  
  1019. # ::tk::FirstMenu --
  1020. # This procedure traverses to the first menubutton in the toplevel
  1021. # for a given window, and posts that menubutton's menu.
  1022. #
  1023. # Arguments:
  1024. # w -                Name of a window.  Selects which toplevel
  1025. #                to search for menubuttons.
  1026.  
  1027. proc ::tk::FirstMenu w {
  1028.     variable ::tk::Priv
  1029.     set w [MenuFind [winfo toplevel $w] ""]
  1030.     if {$w ne ""} {
  1031.     if {[winfo class $w] eq "Menu"} {
  1032.         tk_menuSetFocus $w
  1033.         set Priv(window) $w
  1034.         SaveGrabInfo $w
  1035.         grab -global $w
  1036.         MenuFirstEntry $w
  1037.     } else {
  1038.         MbPost $w
  1039.         MenuFirstEntry [$w cget -menu]
  1040.     }
  1041.     }
  1042. }
  1043.  
  1044. # ::tk::TraverseWithinMenu
  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 ::tk::TraverseWithinMenu {w char} {
  1056.     if {$char eq ""} {
  1057.     return
  1058.     }
  1059.     set char [string tolower $char]
  1060.     set last [$w index last]
  1061.     if {$last eq "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 {$char eq [string tolower $char2]} {
  1070.         if {[$w type $i] eq "cascade"} {
  1071.         $w activate $i
  1072.         $w postcascade active
  1073.         event generate $w <<MenuSelect>>
  1074.         set m2 [$w entrycget $i -menu]
  1075.         if {$m2 ne ""} {
  1076.             MenuFirstEntry $m2
  1077.         }
  1078.         } else {
  1079.         MenuUnpost $w
  1080.         uplevel #0 [list $w invoke $i]
  1081.         }
  1082.         return
  1083.     }
  1084.     }
  1085. }
  1086.  
  1087. # ::tk::MenuFirstEntry --
  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 tk::PostOverPoint) 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 ::tk::MenuFirstEntry menu {
  1099.     if {$menu eq ""} {
  1100.     return
  1101.     }
  1102.     tk_menuSetFocus $menu
  1103.     if {[$menu index active] ne "none"} {
  1104.     return
  1105.     }
  1106.     set last [$menu index last]
  1107.     if {$last eq "none"} {
  1108.     return
  1109.     }
  1110.     for {set i 0} {$i <= $last} {incr i} {
  1111.     if {([catch {set state [$menu entrycget $i -state]}] == 0) \
  1112.         && $state ne "disabled" && [$menu type $i] ne "tearoff"} {
  1113.         $menu activate $i
  1114.         GenerateMenuSelect $menu
  1115.         # Only post the cascade if the current menu is a menubar;
  1116.         # otherwise, if the first entry of the cascade is a cascade,
  1117.         # we can get an annoying cascading effect resulting in a bunch of
  1118.         # menus getting posted (bug 676)
  1119.         if {[$menu type $i] eq "cascade" \
  1120.             && [$menu cget -type] eq "menubar"} {
  1121.         set cascade [$menu entrycget $i -menu]
  1122.         if {$cascade ne ""} {
  1123.             $menu postcascade $i
  1124.             MenuFirstEntry $cascade
  1125.         }
  1126.         }
  1127.         return
  1128.     }
  1129.     }
  1130. }
  1131.  
  1132. # ::tk::MenuFindName --
  1133. # Given a menu and a text string, return the index of the menu entry
  1134. # that displays the string as its label.  If there is no such entry,
  1135. # return an empty string.  This procedure is tricky because some names
  1136. # like "active" have a special meaning in menu commands, so we can't
  1137. # always use the "index" widget command.
  1138. #
  1139. # Arguments:
  1140. # menu -        Name of the menu widget.
  1141. # s -            String to look for.
  1142.  
  1143. proc ::tk::MenuFindName {menu s} {
  1144.     set i ""
  1145.     if {![regexp {^active$|^last$|^none$|^[0-9]|^@} $s]} {
  1146.     catch {set i [$menu index $s]}
  1147.     return $i
  1148.     }
  1149.     set last [$menu index last]
  1150.     if {$last eq "none"} {
  1151.     return
  1152.     }
  1153.     for {set i 0} {$i <= $last} {incr i} {
  1154.     if {![catch {$menu entrycget $i -label} label]} {
  1155.         if {$label eq $s} {
  1156.         return $i
  1157.         }
  1158.     }
  1159.     }
  1160.     return ""
  1161. }
  1162.  
  1163. # ::tk::PostOverPoint --
  1164. # This procedure posts a given menu such that a given entry in the
  1165. # menu is centered over a given point in the root window.  It also
  1166. # activates the given entry.
  1167. #
  1168. # Arguments:
  1169. # menu -        Menu to post.
  1170. # x, y -        Root coordinates of point.
  1171. # entry -        Index of entry within menu to center over (x,y).
  1172. #            If omitted or specified as {}, then the menu's
  1173. #            upper-left corner goes at (x,y).
  1174.  
  1175. proc ::tk::PostOverPoint {menu x y {entry {}}}  {
  1176.     global tcl_platform
  1177.     
  1178.     if {$entry ne ""} {
  1179.     if {$entry == [$menu index last]} {
  1180.         incr y [expr {-([$menu yposition $entry] \
  1181.             + [winfo reqheight $menu])/2}]
  1182.     } else {
  1183.         incr y [expr {-([$menu yposition $entry] \
  1184.             + [$menu yposition [expr {$entry+1}]])/2}]
  1185.     }
  1186.     incr x [expr {-[winfo reqwidth $menu]/2}]
  1187.     }
  1188.     if {$tcl_platform(platform) == "windows"} {
  1189.     # We need to fix some problems with menu posting on Windows,
  1190.     # where, if the menu would overlap top or bottom of screen,
  1191.     # Windows puts it in the wrong place for us.  We must also
  1192.     # subtract an extra amount for half the height of the current
  1193.     # entry.  To be safe we subtract an extra 10.
  1194.     set yoffset [expr {[winfo screenheight $menu] \
  1195.         - $y - [winfo reqheight $menu] - 10}]
  1196.     if {$yoffset < 0} {
  1197.         # The bottom of the menu is offscreen, so adjust upwards
  1198.         incr y $yoffset
  1199.         if {$y < 0} { set y 0 }
  1200.     }
  1201.     # If we're off the top of the screen (either because we were
  1202.     # originally or because we just adjusted too far upwards),
  1203.     # then make the menu popup on the top edge.
  1204.     if {$y < 0} {
  1205.         set y 0
  1206.     }
  1207.     }
  1208.     $menu post $x $y
  1209.     if {$entry ne "" && [$menu entrycget $entry -state] ne "disabled"} {
  1210.     $menu activate $entry
  1211.     GenerateMenuSelect $menu
  1212.     }
  1213. }
  1214.  
  1215. # ::tk::SaveGrabInfo --
  1216. # Sets the variables tk::Priv(oldGrab) and tk::Priv(grabStatus) to record
  1217. # the state of any existing grab on the w's display.
  1218. #
  1219. # Arguments:
  1220. # w -            Name of a window;  used to select the display
  1221. #            whose grab information is to be recorded.
  1222.  
  1223. proc tk::SaveGrabInfo w {
  1224.     variable ::tk::Priv
  1225.     set Priv(oldGrab) [grab current $w]
  1226.     if {$Priv(oldGrab) ne ""} {
  1227.     set Priv(grabStatus) [grab status $Priv(oldGrab)]
  1228.     }
  1229. }
  1230.  
  1231. # ::tk::RestoreOldGrab --
  1232. # Restores the grab to what it was before TkSaveGrabInfo was called.
  1233. #
  1234.  
  1235. proc ::tk::RestoreOldGrab {} {
  1236.     variable ::tk::Priv
  1237.  
  1238.     if {$Priv(oldGrab) ne ""} {
  1239.         # Be careful restoring the old grab, since it's window may not
  1240.     # be visible anymore.
  1241.  
  1242.     catch {
  1243.         if {$Priv(grabStatus) eq "global"} {
  1244.         grab set -global $Priv(oldGrab)
  1245.         } else {
  1246.         grab set $Priv(oldGrab)
  1247.         }
  1248.     }
  1249.     set Priv(oldGrab) ""
  1250.     }
  1251. }
  1252.  
  1253. proc ::tk_menuSetFocus {menu} {
  1254.     variable ::tk::Priv
  1255.     if {![info exists Priv(focus)] || $Priv(focus) eq ""} {
  1256.     set Priv(focus) [focus]
  1257.     }
  1258.     focus $menu
  1259. }
  1260.     
  1261. proc ::tk::GenerateMenuSelect {menu} {
  1262.     variable ::tk::Priv
  1263.  
  1264.     if {$Priv(activeMenu) eq $menu \
  1265.         && $Priv(activeItem) eq [$menu index active]} {
  1266.     return
  1267.     }
  1268.  
  1269.     set Priv(activeMenu) $menu
  1270.     set Priv(activeItem) [$menu index active]
  1271.     event generate $menu <<MenuSelect>>
  1272. }
  1273.  
  1274. # ::tk_popup --
  1275. # This procedure pops up a menu and sets things up for traversing
  1276. # the menu and its submenus.
  1277. #
  1278. # Arguments:
  1279. # menu -        Name of the menu to be popped up.
  1280. # x, y -        Root coordinates at which to pop up the
  1281. #            menu.
  1282. # entry -        Index of a menu entry to center over (x,y).
  1283. #            If omitted or specified as {}, then menu's
  1284. #            upper-left corner goes at (x,y).
  1285.  
  1286. proc ::tk_popup {menu x y {entry {}}} {
  1287.     variable ::tk::Priv
  1288.     global tcl_platform
  1289.     if {$Priv(popup) ne "" || $Priv(postedMb) ne ""} {
  1290.     tk::MenuUnpost {}
  1291.     }
  1292.     tk::PostOverPoint $menu $x $y $entry
  1293.     if {[tk windowingsystem] eq "x11" && [winfo viewable $menu]} {
  1294.         tk::SaveGrabInfo $menu
  1295.     grab -global $menu
  1296.     set Priv(popup) $menu
  1297.     tk_menuSetFocus $menu
  1298.     }
  1299. }
  1300.