home *** CD-ROM | disk | FTP | other *** search
/ PC World 2005 June / PCWorld_2005-06_cd.bin / software / vyzkuste / firewally / firewally.exe / framework-2.3.exe / menu.tcl < prev    next >
Text File  |  2003-09-01  |  37KB  |  1,296 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.18 2002/08/31 06:12:28 das 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 {[string equal [tk windowingsystem] "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 {[string compare $Priv(inMenubutton) ""]} {
  203.     MbLeave $Priv(inMenubutton)
  204.     }
  205.     set Priv(inMenubutton) $w
  206.     if {[string compare [$w cget -state] "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 {[string equal [$w cget -state] "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 {[string equal $menu ""]} {
  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 {[string compare $cur ""]} {
  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.         PostOverPoint $menu $x $y
  284.             }
  285.             below {
  286.                 set x [winfo rootx $w]
  287.                 set y [expr {[winfo rooty $w] + [winfo height $w]}]
  288.         PostOverPoint $menu $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 [MenuFindName $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.         PostOverPoint $menu $x $y
  304.         if {$entry ne "" \
  305.             && [$menu entrycget $entry -state] ne "disabled"} {
  306.                     $menu activate $entry
  307.             GenerateMenuSelect $menu
  308.                 }
  309.             }
  310.             right {
  311.                 set x [expr {[winfo rootx $w] + [winfo width $w]}]
  312.                 set y [expr {(2 * [winfo rooty $w] + [winfo height $w]) / 2}]
  313.                 set entry [MenuFindName $menu [$w cget -text]]
  314.                 if {[$w cget -indicatoron]} {
  315.             if {$entry == [$menu index last]} {
  316.                 incr y [expr {-([$menu yposition $entry] \
  317.                     + [winfo reqheight $menu])/2}]
  318.             } else {
  319.                 incr y [expr {-([$menu yposition $entry] \
  320.                     + [$menu yposition [expr {$entry+1}]])/2}]
  321.             }
  322.                 }
  323.         PostOverPoint $menu $x $y
  324.         if {$entry ne "" \
  325.             && [$menu entrycget $entry -state] ne "disabled"} {
  326.                     $menu activate $entry
  327.             GenerateMenuSelect $menu
  328.                 }
  329.             }
  330.             default {
  331.                 if {[$w cget -indicatoron]} {
  332.             if {[string equal $y {}]} {
  333.             set x [expr {[winfo rootx $w] + [winfo width $w]/2}]
  334.             set y [expr {[winfo rooty $w] + [winfo height $w]/2}]
  335.                 }
  336.                 PostOverPoint $menu $x $y [MenuFindName $menu [$w cget -text]]
  337.         } else {
  338.             PostOverPoint $menu [winfo rootx $w] [expr {[winfo rooty $w]+[winfo height $w]}]
  339.                 }  
  340.             }
  341.     }
  342.     } msg]} {
  343.     # Error posting menu (e.g. bogus -postcommand). Unpost it and
  344.     # reflect the error.
  345.     
  346.     set savedInfo $errorInfo
  347.     MenuUnpost {}
  348.     error $msg $savedInfo
  349.  
  350.     }
  351.  
  352.     set Priv(tearoff) $tearoff
  353.     if {$tearoff != 0} {
  354.         focus $menu
  355.     if {[winfo viewable $w]} {
  356.         SaveGrabInfo $w
  357.         grab -global $w
  358.     }
  359.     }
  360. }
  361.  
  362. # ::tk::MenuUnpost --
  363. # This procedure unposts a given menu, plus all of its ancestors up
  364. # to (and including) a menubutton, if any.  It also restores various
  365. # values to what they were before the menu was posted, and releases
  366. # a grab if there's a menubutton involved.  Special notes:
  367. # 1. It's important to unpost all menus before releasing the grab, so
  368. #    that any Enter-Leave events (e.g. from menu back to main
  369. #    application) have mode NotifyGrab.
  370. # 2. Be sure to enclose various groups of commands in "catch" so that
  371. #    the procedure will complete even if the menubutton or the menu
  372. #    or the grab window has been deleted.
  373. #
  374. # Arguments:
  375. # menu -        Name of a menu to unpost.  Ignored if there
  376. #            is a posted menubutton.
  377.  
  378. proc ::tk::MenuUnpost menu {
  379.     global tcl_platform
  380.     variable ::tk::Priv
  381.     set mb $Priv(postedMb)
  382.  
  383.     # Restore focus right away (otherwise X will take focus away when
  384.     # the menu is unmapped and under some window managers (e.g. olvwm)
  385.     # we'll lose the focus completely).
  386.  
  387.     catch {focus $Priv(focus)}
  388.     set Priv(focus) ""
  389.  
  390.     # Unpost menu(s) and restore some stuff that's dependent on
  391.     # what was posted.
  392.  
  393.     catch {
  394.     if {[string compare $mb ""]} {
  395.         set menu [$mb cget -menu]
  396.         $menu unpost
  397.         set Priv(postedMb) {}
  398.         $mb configure -cursor $Priv(cursor)
  399.         $mb configure -relief $Priv(relief)
  400.     } elseif {[string compare $Priv(popup) ""]} {
  401.         $Priv(popup) unpost
  402.         set Priv(popup) {}
  403.     } elseif {[string compare [$menu cget -type] "menubar"] \
  404.         && [string compare [$menu cget -type] "tearoff"]} {
  405.         # We're in a cascaded sub-menu from a torn-off menu or popup.
  406.         # Unpost all the menus up to the toplevel one (but not
  407.         # including the top-level torn-off one) and deactivate the
  408.         # top-level torn off menu if there is one.
  409.  
  410.         while {1} {
  411.         set parent [winfo parent $menu]
  412.         if {[string compare [winfo class $parent] "Menu"] \
  413.             || ![winfo ismapped $parent]} {
  414.             break
  415.         }
  416.         $parent activate none
  417.         $parent postcascade none
  418.         GenerateMenuSelect $parent
  419.         set type [$parent cget -type]
  420.         if {[string equal $type "menubar"] || \
  421.             [string equal $type "tearoff"]} {
  422.             break
  423.         }
  424.         set menu $parent
  425.         }
  426.         if {[string compare [$menu cget -type] "menubar"]} {
  427.         $menu unpost
  428.         }
  429.     }
  430.     }
  431.  
  432.     if {($Priv(tearoff) != 0) || $Priv(menuBar) ne ""} {
  433.         # Release grab, if any, and restore the previous grab, if there
  434.         # was one.
  435.     if {[string compare $menu ""]} {
  436.         set grab [grab current $menu]
  437.         if {[string compare $grab ""]} {
  438.         grab release $grab
  439.         }
  440.     }
  441.     RestoreOldGrab
  442.     if {$Priv(menuBar) ne ""} {
  443.         $Priv(menuBar) configure -cursor $Priv(cursor)
  444.         set Priv(menuBar) {}
  445.     }
  446.     if {[tk windowingsystem] ne "x11"} {
  447.         set Priv(tearoff) 0
  448.     }
  449.     }
  450. }
  451.  
  452. # ::tk::MbMotion --
  453. # This procedure handles mouse motion events inside menubuttons, and
  454. # also outside menubuttons when a menubutton has a grab (e.g. when a
  455. # menu selection operation is in progress).
  456. #
  457. # Arguments:
  458. # w -            The name of the menubutton widget.
  459. # upDown -         "down" means button 1 is pressed, "up" means
  460. #            it isn't.
  461. # rootx, rooty -    Coordinates of mouse, in (virtual?) root window.
  462.  
  463. proc ::tk::MbMotion {w upDown rootx rooty} {
  464.     variable ::tk::Priv
  465.  
  466.     if {[string equal $Priv(inMenubutton) $w]} {
  467.     return
  468.     }
  469.     set new [winfo containing $rootx $rooty]
  470.     if {[string compare $new $Priv(inMenubutton)] \
  471.         && ([string equal $new ""] \
  472.         || [string equal [winfo toplevel $new] [winfo toplevel $w]])} {
  473.     if {[string compare $Priv(inMenubutton) ""]} {
  474.         MbLeave $Priv(inMenubutton)
  475.     }
  476.     if {[string compare $new ""] \
  477.         && [string equal [winfo class $new] "Menubutton"] \
  478.         && ([$new cget -indicatoron] == 0) \
  479.         && ([$w cget -indicatoron] == 0)} {
  480.         if {[string equal $upDown "down"]} {
  481.         MbPost $new $rootx $rooty
  482.         } else {
  483.         MbEnter $new
  484.         }
  485.     }
  486.     }
  487. }
  488.  
  489. # ::tk::MbButtonUp --
  490. # This procedure is invoked to handle button 1 releases for menubuttons.
  491. # If the release happens inside the menubutton then leave its menu
  492. # posted with element 0 activated.  Otherwise, unpost the menu.
  493. #
  494. # Arguments:
  495. # w -            The name of the menubutton widget.
  496.  
  497. proc ::tk::MbButtonUp w {
  498.     variable ::tk::Priv
  499.     global tcl_platform
  500.  
  501.     set menu [$w cget -menu]
  502.     set tearoff [expr {[tk windowingsystem] eq "x11" || \
  503.         ($menu ne "" && [$menu cget -type] eq "tearoff")}]
  504.     if {($tearoff != 0) && $Priv(postedMb) eq $w \
  505.         && $Priv(inMenubutton) eq $w} {
  506.     MenuFirstEntry [$Priv(postedMb) cget -menu]
  507.     } else {
  508.     MenuUnpost {}
  509.     }
  510. }
  511.  
  512. # ::tk::MenuMotion --
  513. # This procedure is called to handle mouse motion events for menus.
  514. # It does two things.  First, it resets the active element in the
  515. # menu, if the mouse is over the menu.  Second, if a mouse button
  516. # is down, it posts and unposts cascade entries to match the mouse
  517. # position.
  518. #
  519. # Arguments:
  520. # menu -        The menu window.
  521. # x -            The x position of the mouse.
  522. # y -            The y position of the mouse.
  523. # state -        Modifier state (tells whether buttons are down).
  524.  
  525. proc ::tk::MenuMotion {menu x y state} {
  526.     variable ::tk::Priv
  527.     if {[string equal $menu $Priv(window)]} {
  528.     if {[string equal [$menu cget -type] "menubar"]} {
  529.         if {[info exists Priv(focus)] && \
  530.             [string compare $menu $Priv(focus)]} {
  531.         $menu activate @$x,$y
  532.         GenerateMenuSelect $menu
  533.         }
  534.     } else {
  535.         $menu activate @$x,$y
  536.         GenerateMenuSelect $menu
  537.     }
  538.     }
  539.     if {($state & 0x1f00) != 0} {
  540.     $menu postcascade active
  541.     }
  542. }
  543.  
  544. # ::tk::MenuButtonDown --
  545. # Handles button presses in menus.  There are a couple of tricky things
  546. # here:
  547. # 1. Change the posted cascade entry (if any) to match the mouse position.
  548. # 2. If there is a posted menubutton, must grab to the menubutton;  this
  549. #    overrrides the implicit grab on button press, so that the menu
  550. #    button can track mouse motions over other menubuttons and change
  551. #    the posted menu.
  552. # 3. If there's no posted menubutton (e.g. because we're a torn-off menu
  553. #    or one of its descendants) must grab to the top-level menu so that
  554. #    we can track mouse motions across the entire menu hierarchy.
  555. #
  556. # Arguments:
  557. # menu -        The menu window.
  558.  
  559. proc ::tk::MenuButtonDown menu {
  560.     variable ::tk::Priv
  561.     global tcl_platform
  562.  
  563.     if {![winfo viewable $menu]} {
  564.         return
  565.     }
  566.     $menu postcascade active
  567.     if {[string compare $Priv(postedMb) ""] && \
  568.         [winfo viewable $Priv(postedMb)]} {
  569.     grab -global $Priv(postedMb)
  570.     } else {
  571.     while {[string equal [$menu cget -type] "normal"] \
  572.         && [string equal [winfo class [winfo parent $menu]] "Menu"] \
  573.         && [winfo ismapped [winfo parent $menu]]} {
  574.         set menu [winfo parent $menu]
  575.     }
  576.  
  577.     if {[string equal $Priv(menuBar) {}]} {
  578.         set Priv(menuBar) $menu
  579.         set Priv(cursor) [$menu cget -cursor]
  580.         $menu configure -cursor arrow
  581.         }
  582.  
  583.     # Don't update grab information if the grab window isn't changing.
  584.     # Otherwise, we'll get an error when we unpost the menus and
  585.     # restore the grab, since the old grab window will not be viewable
  586.     # anymore.
  587.  
  588.     if {[string compare $menu [grab current $menu]]} {
  589.         SaveGrabInfo $menu
  590.     }
  591.  
  592.     # Must re-grab even if the grab window hasn't changed, in order
  593.     # to release the implicit grab from the button press.
  594.  
  595.     if {[string equal [tk windowingsystem] "x11"]} {
  596.         grab -global $menu
  597.     }
  598.     }
  599. }
  600.  
  601. # ::tk::MenuLeave --
  602. # This procedure is invoked to handle Leave events for a menu.  It
  603. # deactivates everything unless the active element is a cascade element
  604. # and the mouse is now over the submenu.
  605. #
  606. # Arguments:
  607. # menu -        The menu window.
  608. # rootx, rooty -    Root coordinates of mouse.
  609. # state -        Modifier state.
  610.  
  611. proc ::tk::MenuLeave {menu rootx rooty state} {
  612.     variable ::tk::Priv
  613.     set Priv(window) {}
  614.     if {[string equal [$menu index active] "none"]} {
  615.     return
  616.     }
  617.     if {[string equal [$menu type active] "cascade"]
  618.           && [string equal [winfo containing $rootx $rooty] \
  619.                   [$menu entrycget active -menu]]} {
  620.     return
  621.     }
  622.     $menu activate none
  623.     GenerateMenuSelect $menu
  624. }
  625.  
  626. # ::tk::MenuInvoke --
  627. # This procedure is invoked when button 1 is released over a menu.
  628. # It invokes the appropriate menu action and unposts the menu if
  629. # it came from a menubutton.
  630. #
  631. # Arguments:
  632. # w -            Name of the menu widget.
  633. # buttonRelease -    1 means this procedure is called because of
  634. #            a button release;  0 means because of keystroke.
  635.  
  636. proc ::tk::MenuInvoke {w buttonRelease} {
  637.     variable ::tk::Priv
  638.  
  639.     if {$buttonRelease && [string equal $Priv(window) {}]} {
  640.     # Mouse was pressed over a menu without a menu button, then
  641.     # dragged off the menu (possibly with a cascade posted) and
  642.     # released.  Unpost everything and quit.
  643.  
  644.     $w postcascade none
  645.     $w activate none
  646.     event generate $w <<MenuSelect>>
  647.     MenuUnpost $w
  648.     return
  649.     }
  650.     if {[string equal [$w type active] "cascade"]} {
  651.     $w postcascade active
  652.     set menu [$w entrycget active -menu]
  653.     MenuFirstEntry $menu
  654.     } elseif {[string equal [$w type active] "tearoff"]} {
  655.     ::tk::TearOffMenu $w
  656.     MenuUnpost $w
  657.     } elseif {[string equal [$w cget -type] "menubar"]} {
  658.     $w postcascade none
  659.     set active [$w index active]
  660.     set isCascade [string equal [$w type $active] "cascade"]
  661.  
  662.     # Only de-activate the active item if it's a cascade; this prevents
  663.     # the annoying "activation flicker" you otherwise get with 
  664.     # checkbuttons/commands/etc. on menubars
  665.  
  666.     if { $isCascade } {
  667.         $w activate none
  668.         event generate $w <<MenuSelect>>
  669.     }
  670.  
  671.     MenuUnpost $w
  672.  
  673.     # If the active item is not a cascade, invoke it.  This enables
  674.     # the use of checkbuttons/commands/etc. on menubars (which is legal,
  675.     # but not recommended)
  676.  
  677.     if { !$isCascade } {
  678.         uplevel #0 [list $w invoke $active]
  679.     }
  680.     } else {
  681.     MenuUnpost $w
  682.     uplevel #0 [list $w invoke active]
  683.     }
  684. }
  685.  
  686. # ::tk::MenuEscape --
  687. # This procedure is invoked for the Cancel (or Escape) key.  It unposts
  688. # the given menu and, if it is the top-level menu for a menu button,
  689. # unposts the menu button as well.
  690. #
  691. # Arguments:
  692. # menu -        Name of the menu window.
  693.  
  694. proc ::tk::MenuEscape menu {
  695.     set parent [winfo parent $menu]
  696.     if {[string compare [winfo class $parent] "Menu"]} {
  697.     MenuUnpost $menu
  698.     } elseif {[string equal [$parent cget -type] "menubar"]} {
  699.     MenuUnpost $menu
  700.     RestoreOldGrab
  701.     } else {
  702.     MenuNextMenu $menu left
  703.     }
  704. }
  705.  
  706. # The following routines handle arrow keys. Arrow keys behave
  707. # differently depending on whether the menu is a menu bar or not.
  708.  
  709. proc ::tk::MenuUpArrow {menu} {
  710.     if {[string equal [$menu cget -type] "menubar"]} {
  711.     MenuNextMenu $menu left
  712.     } else {
  713.     MenuNextEntry $menu -1
  714.     }
  715. }
  716.  
  717. proc ::tk::MenuDownArrow {menu} {
  718.     if {[string equal [$menu cget -type] "menubar"]} {
  719.     MenuNextMenu $menu right
  720.     } else {
  721.     MenuNextEntry $menu 1
  722.     }
  723. }
  724.  
  725. proc ::tk::MenuLeftArrow {menu} {
  726.     if {[string equal [$menu cget -type] "menubar"]} {
  727.     MenuNextEntry $menu -1
  728.     } else {
  729.     MenuNextMenu $menu left
  730.     }
  731. }
  732.  
  733. proc ::tk::MenuRightArrow {menu} {
  734.     if {[string equal [$menu cget -type] "menubar"]} {
  735.     MenuNextEntry $menu 1
  736.     } else {
  737.     MenuNextMenu $menu right
  738.     }
  739. }
  740.  
  741. # ::tk::MenuNextMenu --
  742. # This procedure is invoked to handle "left" and "right" traversal
  743. # motions in menus.  It traverses to the next menu in a menu bar,
  744. # or into or out of a cascaded menu.
  745. #
  746. # Arguments:
  747. # menu -        The menu that received the keyboard
  748. #            event.
  749. # direction -        Direction in which to move: "left" or "right"
  750.  
  751. proc ::tk::MenuNextMenu {menu direction} {
  752.     variable ::tk::Priv
  753.  
  754.     # First handle traversals into and out of cascaded menus.
  755.  
  756.     if {[string equal $direction "right"]} {
  757.     set count 1
  758.     set parent [winfo parent $menu]
  759.     set class [winfo class $parent]
  760.     if {[string equal [$menu type active] "cascade"]} {
  761.         $menu postcascade active
  762.         set m2 [$menu entrycget active -menu]
  763.         if {[string compare $m2 ""]} {
  764.         MenuFirstEntry $m2
  765.         }
  766.         return
  767.     } else {
  768.         set parent [winfo parent $menu]
  769.         while {[string compare $parent "."]} {
  770.         if {[string equal [winfo class $parent] "Menu"] \
  771.             && [string equal [$parent cget -type] "menubar"]} {
  772.             tk_menuSetFocus $parent
  773.             MenuNextEntry $parent 1
  774.             return
  775.         }
  776.         set parent [winfo parent $parent]
  777.         }
  778.     }
  779.     } else {
  780.     set count -1
  781.     set m2 [winfo parent $menu]
  782.     if {[string equal [winfo class $m2] "Menu"]} {
  783.         $menu activate none
  784.         GenerateMenuSelect $menu
  785.         tk_menuSetFocus $m2
  786.  
  787.         $m2 postcascade none
  788.  
  789.         if {[string compare [$m2 cget -type] "menubar"]} {
  790.         return
  791.         }
  792.     }
  793.     }
  794.  
  795.     # Can't traverse into or out of a cascaded menu.  Go to the next
  796.     # or previous menubutton, if that makes sense.
  797.  
  798.     set m2 [winfo parent $menu]
  799.     if {[string equal [winfo class $m2] "Menu"]} {
  800.     if {[string equal [$m2 cget -type] "menubar"]} {
  801.         tk_menuSetFocus $m2
  802.         MenuNextEntry $m2 -1
  803.         return
  804.     }
  805.     }
  806.  
  807.     set w $Priv(postedMb)
  808.     if {[string equal $w ""]} {
  809.     return
  810.     }
  811.     set buttons [winfo children [winfo parent $w]]
  812.     set length [llength $buttons]
  813.     set i [expr {[lsearch -exact $buttons $w] + $count}]
  814.     while {1} {
  815.     while {$i < 0} {
  816.         incr i $length
  817.     }
  818.     while {$i >= $length} {
  819.         incr i -$length
  820.     }
  821.     set mb [lindex $buttons $i]
  822.     if {[string equal [winfo class $mb] "Menubutton"] \
  823.         && [string compare [$mb cget -state] "disabled"] \
  824.         && [string compare [$mb cget -menu] ""] \
  825.         && [string compare [[$mb cget -menu] index last] "none"]} {
  826.         break
  827.     }
  828.     if {[string equal $mb $w]} {
  829.         return
  830.     }
  831.     incr i $count
  832.     }
  833.     MbPost $mb
  834.     MenuFirstEntry [$mb cget -menu]
  835. }
  836.  
  837. # ::tk::MenuNextEntry --
  838. # Activate the next higher or lower entry in the posted menu,
  839. # wrapping around at the ends.  Disabled entries are skipped.
  840. #
  841. # Arguments:
  842. # menu -            Menu window that received the keystroke.
  843. # count -            1 means go to the next lower entry,
  844. #                -1 means go to the next higher entry.
  845.  
  846. proc ::tk::MenuNextEntry {menu count} {
  847.  
  848.     if {[string equal [$menu index last] "none"]} {
  849.     return
  850.     }
  851.     set length [expr {[$menu index last]+1}]
  852.     set quitAfter $length
  853.     set active [$menu index active]
  854.     if {[string equal $active "none"]} {
  855.     set i 0
  856.     } else {
  857.     set i [expr {$active + $count}]
  858.     }
  859.     while {1} {
  860.     if {$quitAfter <= 0} {
  861.         # We've tried every entry in the menu.  Either there are
  862.         # none, or they're all disabled.  Just give up.
  863.  
  864.         return
  865.     }
  866.     while {$i < 0} {
  867.         incr i $length
  868.     }
  869.     while {$i >= $length} {
  870.         incr i -$length
  871.     }
  872.     if {[catch {$menu entrycget $i -state} state] == 0} {
  873.         if {$state ne "disabled" && \
  874.             ($i!=0 || [$menu cget -type] ne "tearoff" \
  875.             || [$menu type 0] ne "tearoff")} {
  876.         break
  877.         }
  878.     }
  879.     if {$i == $active} {
  880.         return
  881.     }
  882.     incr i $count
  883.     incr quitAfter -1
  884.     }
  885.     $menu activate $i
  886.     GenerateMenuSelect $menu
  887.  
  888.     if {[string equal [$menu type $i] "cascade"] \
  889.         && [string equal [$menu cget -type] "menubar"]} {
  890.     set cascade [$menu entrycget $i -menu]
  891.     if {[string compare $cascade ""]} {
  892.         # Here we auto-post a cascade.  This is necessary when
  893.         # we traverse left/right in the menubar, but undesirable when
  894.         # we traverse up/down in a menu.
  895.         $menu postcascade $i
  896.         MenuFirstEntry $cascade
  897.     }
  898.     }
  899. }
  900.  
  901. # ::tk::MenuFind --
  902. # This procedure searches the entire window hierarchy under w for
  903. # a menubutton that isn't disabled and whose underlined character
  904. # is "char" or an entry in a menubar that isn't disabled and whose
  905. # underlined character is "char".
  906. # It returns the name of that window, if found, or an
  907. # empty string if no matching window was found.  If "char" is an
  908. # empty string then the procedure returns the name of the first
  909. # menubutton found that isn't disabled.
  910. #
  911. # Arguments:
  912. # w -                Name of window where key was typed.
  913. # char -            Underlined character to search for;
  914. #                may be either upper or lower case, and
  915. #                will match either upper or lower case.
  916.  
  917. proc ::tk::MenuFind {w char} {
  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 $w] [winfo toplevel $child]]} {
  924.         continue
  925.     }
  926.     if {[string equal [winfo class $child] "Menu"] && \
  927.         [string equal [$child cget -type] "menubar"]} {
  928.         if {[string equal $char ""]} {
  929.         return $child
  930.         }
  931.         set last [$child index last]
  932.         for {set i [$child cget -tearoff]} {$i <= $last} {incr i} {
  933.         if {[string equal [$child type $i] "separator"]} {
  934.             continue
  935.         }
  936.         set char2 [string index [$child entrycget $i -label] \
  937.             [$child entrycget $i -underline]]
  938.         if {[string equal $char [string tolower $char2]] \
  939.             || [string equal $char ""]} {
  940.             if {[string compare [$child entrycget $i -state] "disabled"]} {
  941.             return $child
  942.             }
  943.         }
  944.         }
  945.     }
  946.     }
  947.  
  948.     foreach child $windowlist {
  949.     # Don't descend into other toplevels.
  950.         if {[string compare [winfo toplevel $w] [winfo toplevel $child]]} {
  951.         continue
  952.     }
  953.     switch [winfo class $child] {
  954.         Menubutton {
  955.         set char2 [string index [$child cget -text] \
  956.             [$child cget -underline]]
  957.         if {[string equal $char [string tolower $char2]] \
  958.             || [string equal $char ""]} {
  959.             if {[string compare [$child cget -state] "disabled"]} {
  960.             return $child
  961.             }
  962.         }
  963.         }
  964.  
  965.         default {
  966.         set match [MenuFind $child $char]
  967.         if {[string compare $match ""]} {
  968.             return $match
  969.         }
  970.         }
  971.     }
  972.     }
  973.     return {}
  974. }
  975.  
  976. # ::tk::TraverseToMenu --
  977. # This procedure implements keyboard traversal of menus.  Given an
  978. # ASCII character "char", it looks for a menubutton with that character
  979. # underlined.  If one is found, it posts the menubutton's menu
  980. #
  981. # Arguments:
  982. # w -                Window in which the key was typed (selects
  983. #                a toplevel window).
  984. # char -            Character that selects a menu.  The case
  985. #                is ignored.  If an empty string, nothing
  986. #                happens.
  987.  
  988. proc ::tk::TraverseToMenu {w char} {
  989.     variable ::tk::Priv
  990.     if {[string equal $char ""]} {
  991.     return
  992.     }
  993.     while {[string equal [winfo class $w] "Menu"]} {
  994.     if {[string compare [$w cget -type] "menubar"] \
  995.         && [string equal $Priv(postedMb) ""]} {
  996.         return
  997.     }
  998.     if {[string equal [$w cget -type] "menubar"]} {
  999.         break
  1000.     }
  1001.     set w [winfo parent $w]
  1002.     }
  1003.     set w [MenuFind [winfo toplevel $w] $char]
  1004.     if {[string compare $w ""]} {
  1005.     if {[string equal [winfo class $w] "Menu"]} {
  1006.         tk_menuSetFocus $w
  1007.         set Priv(window) $w
  1008.         SaveGrabInfo $w
  1009.         grab -global $w
  1010.         TraverseWithinMenu $w $char
  1011.     } else {
  1012.         MbPost $w
  1013.         MenuFirstEntry [$w cget -menu]
  1014.     }
  1015.     }
  1016. }
  1017.  
  1018. # ::tk::FirstMenu --
  1019. # This procedure traverses to the first menubutton in the toplevel
  1020. # for a given window, and posts that menubutton's menu.
  1021. #
  1022. # Arguments:
  1023. # w -                Name of a window.  Selects which toplevel
  1024. #                to search for menubuttons.
  1025.  
  1026. proc ::tk::FirstMenu w {
  1027.     variable ::tk::Priv
  1028.     set w [MenuFind [winfo toplevel $w] ""]
  1029.     if {[string compare $w ""]} {
  1030.     if {[string equal [winfo class $w] "Menu"]} {
  1031.         tk_menuSetFocus $w
  1032.         set Priv(window) $w
  1033.         SaveGrabInfo $w
  1034.         grab -global $w
  1035.         MenuFirstEntry $w
  1036.     } else {
  1037.         MbPost $w
  1038.         MenuFirstEntry [$w cget -menu]
  1039.     }
  1040.     }
  1041. }
  1042.  
  1043. # ::tk::TraverseWithinMenu
  1044. # This procedure implements keyboard traversal within a menu.  It
  1045. # searches for an entry in the menu that has "char" underlined.  If
  1046. # such an entry is found, it is invoked and the menu is unposted.
  1047. #
  1048. # Arguments:
  1049. # w -                The name of the menu widget.
  1050. # char -            The character to look for;  case is
  1051. #                ignored.  If the string is empty then
  1052. #                nothing happens.
  1053.  
  1054. proc ::tk::TraverseWithinMenu {w char} {
  1055.     if {[string equal $char ""]} {
  1056.     return
  1057.     }
  1058.     set char [string tolower $char]
  1059.     set last [$w index last]
  1060.     if {[string equal $last "none"]} {
  1061.     return
  1062.     }
  1063.     for {set i 0} {$i <= $last} {incr i} {
  1064.     if {[catch {set char2 [string index \
  1065.         [$w entrycget $i -label] [$w entrycget $i -underline]]}]} {
  1066.         continue
  1067.     }
  1068.     if {[string equal $char [string tolower $char2]]} {
  1069.         if {[string equal [$w type $i] "cascade"]} {
  1070.         $w activate $i
  1071.         $w postcascade active
  1072.         event generate $w <<MenuSelect>>
  1073.         set m2 [$w entrycget $i -menu]
  1074.         if {[string compare $m2 ""]} {
  1075.             MenuFirstEntry $m2
  1076.         }
  1077.         } else {
  1078.         MenuUnpost $w
  1079.         uplevel #0 [list $w invoke $i]
  1080.         }
  1081.         return
  1082.     }
  1083.     }
  1084. }
  1085.  
  1086. # ::tk::MenuFirstEntry --
  1087. # Given a menu, this procedure finds the first entry that isn't
  1088. # disabled or a tear-off or separator, and activates that entry.
  1089. # However, if there is already an active entry in the menu (e.g.,
  1090. # because of a previous call to tk::PostOverPoint) then the active
  1091. # entry isn't changed.  This procedure also sets the input focus
  1092. # to the menu.
  1093. #
  1094. # Arguments:
  1095. # menu -        Name of the menu window (possibly empty).
  1096.  
  1097. proc ::tk::MenuFirstEntry menu {
  1098.     if {[string equal $menu ""]} {
  1099.     return
  1100.     }
  1101.     tk_menuSetFocus $menu
  1102.     if {[string compare [$menu index active] "none"]} {
  1103.     return
  1104.     }
  1105.     set last [$menu index last]
  1106.     if {[string equal $last "none"]} {
  1107.     return
  1108.     }
  1109.     for {set i 0} {$i <= $last} {incr i} {
  1110.     if {([catch {set state [$menu entrycget $i -state]}] == 0) \
  1111.         && [string compare $state "disabled"] \
  1112.         && [string compare [$menu type $i] "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 {[string equal [$menu type $i] "cascade"] && \
  1120.         [string equal [$menu cget -type] "menubar"]} {
  1121.         set cascade [$menu entrycget $i -menu]
  1122.         if {[string compare $cascade ""]} {
  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 {[string equal $last "none"]} {
  1151.     return
  1152.     }
  1153.     for {set i 0} {$i <= $last} {incr i} {
  1154.     if {![catch {$menu entrycget $i -label} label]} {
  1155.         if {[string equal $label $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 {[string compare $entry {}]} {
  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.     set yoffset [expr {[winfo screenheight $menu] \
  1191.         - $y - [winfo reqheight $menu]}]
  1192.     if {$yoffset < 0} {
  1193.         # The bottom of the menu is offscreen, so adjust upwards
  1194.         incr y $yoffset
  1195.         if {$y < 0} { set y 0 }
  1196.     }
  1197.     # If we're off the top of the screen (either because we were
  1198.     # originally or because we just adjusted too far upwards),
  1199.     # then make the menu popup on the top edge.
  1200.     if {$y < 0} {
  1201.         set y 0
  1202.     }
  1203.     }
  1204.     $menu post $x $y
  1205.     if {$entry ne "" && [$menu entrycget $entry -state] ne "disabled"} {
  1206.     $menu activate $entry
  1207.     GenerateMenuSelect $menu
  1208.     }
  1209. }
  1210.  
  1211. # ::tk::SaveGrabInfo --
  1212. # Sets the variables tk::Priv(oldGrab) and tk::Priv(grabStatus) to record
  1213. # the state of any existing grab on the w's display.
  1214. #
  1215. # Arguments:
  1216. # w -            Name of a window;  used to select the display
  1217. #            whose grab information is to be recorded.
  1218.  
  1219. proc tk::SaveGrabInfo w {
  1220.     variable ::tk::Priv
  1221.     set Priv(oldGrab) [grab current $w]
  1222.     if {$Priv(oldGrab) ne ""} {
  1223.     set Priv(grabStatus) [grab status $Priv(oldGrab)]
  1224.     }
  1225. }
  1226.  
  1227. # ::tk::RestoreOldGrab --
  1228. # Restores the grab to what it was before TkSaveGrabInfo was called.
  1229. #
  1230.  
  1231. proc ::tk::RestoreOldGrab {} {
  1232.     variable ::tk::Priv
  1233.  
  1234.     if {$Priv(oldGrab) ne ""} {
  1235.         # Be careful restoring the old grab, since it's window may not
  1236.     # be visible anymore.
  1237.  
  1238.     catch {
  1239.           if {[string equal $Priv(grabStatus) "global"]} {
  1240.         grab set -global $Priv(oldGrab)
  1241.         } else {
  1242.         grab set $Priv(oldGrab)
  1243.         }
  1244.     }
  1245.     set Priv(oldGrab) ""
  1246.     }
  1247. }
  1248.  
  1249. proc ::tk_menuSetFocus {menu} {
  1250.     variable ::tk::Priv
  1251.     if {![info exists Priv(focus)] || [string equal $Priv(focus) {}]} {
  1252.     set Priv(focus) [focus]
  1253.     }
  1254.     focus $menu
  1255. }
  1256.     
  1257. proc ::tk::GenerateMenuSelect {menu} {
  1258.     variable ::tk::Priv
  1259.  
  1260.     if {[string equal $Priv(activeMenu) $menu] \
  1261.           && [string equal $Priv(activeItem) [$menu index active]]} {
  1262.     return
  1263.     }
  1264.  
  1265.     set Priv(activeMenu) $menu
  1266.     set Priv(activeItem) [$menu index active]
  1267.     event generate $menu <<MenuSelect>>
  1268. }
  1269.  
  1270. # ::tk_popup --
  1271. # This procedure pops up a menu and sets things up for traversing
  1272. # the menu and its submenus.
  1273. #
  1274. # Arguments:
  1275. # menu -        Name of the menu to be popped up.
  1276. # x, y -        Root coordinates at which to pop up the
  1277. #            menu.
  1278. # entry -        Index of a menu entry to center over (x,y).
  1279. #            If omitted or specified as {}, then menu's
  1280. #            upper-left corner goes at (x,y).
  1281.  
  1282. proc ::tk_popup {menu x y {entry {}}} {
  1283.     variable ::tk::Priv
  1284.     global tcl_platform
  1285.     if {$Priv(popup) ne "" || $Priv(postedMb) ne ""} {
  1286.     tk::MenuUnpost {}
  1287.     }
  1288.     tk::PostOverPoint $menu $x $y $entry
  1289.     if {[tk windowingsystem] eq "x11" && [winfo viewable $menu]} {
  1290.         tk::SaveGrabInfo $menu
  1291.     grab -global $menu
  1292.     set Priv(popup) $menu
  1293.     tk_menuSetFocus $menu
  1294.     }
  1295. }
  1296.