figenc

[RADIOACTIVE] rsa and symmetric key encryption scripts and executables
git clone git://git.figbert.com/figenc.git
Log | Files | Refs | README

menu.tcl (38015B)


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