"Fossies" - the Fresh Open Source Software Archive

Member "install-tl-20200916/tlpkg/tltcl/lib/tk8.6/menu.tcl" (17 Mar 2020, 38491 Bytes) of package /windows/misc/install-tl.zip:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Tcl/Tk source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file.

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