diff -r 000000000000 -r ae805ac0140d python-2.5.2/win32/tcl/tk8.4/menu.tcl
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/python-2.5.2/win32/tcl/tk8.4/menu.tcl	Fri Apr 03 17:19:34 2009 +0100
@@ -0,0 +1,1311 @@
+# menu.tcl --
+#
+# This file defines the default bindings for Tk menus and menubuttons.
+# It also implements keyboard traversal of menus and implements a few
+# other utility procedures related to menus.
+#
+# RCS: @(#) $Id: menu.tcl,v 1.18.2.3 2005/12/01 17:47:14 hobbs Exp $
+#
+# Copyright (c) 1992-1994 The Regents of the University of California.
+# Copyright (c) 1994-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+#-------------------------------------------------------------------------
+# Elements of tk::Priv that are used in this file:
+#
+# cursor -		Saves the -cursor option for the posted menubutton.
+# focus -		Saves the focus during a menu selection operation.
+#			Focus gets restored here when the menu is unposted.
+# grabGlobal -		Used in conjunction with tk::Priv(oldGrab):  if
+#			tk::Priv(oldGrab) is non-empty, then tk::Priv(grabGlobal)
+#			contains either an empty string or "-global" to
+#			indicate whether the old grab was a local one or
+#			a global one.
+# inMenubutton -	The name of the menubutton widget containing
+#			the mouse, or an empty string if the mouse is
+#			not over any menubutton.
+# menuBar -		The name of the menubar that is the root
+#			of the cascade hierarchy which is currently
+#			posted. This is null when there is no menu currently
+#			being pulled down from a menu bar.
+# oldGrab -		Window that had the grab before a menu was posted.
+#			Used to restore the grab state after the menu
+#			is unposted.  Empty string means there was no
+#			grab previously set.
+# popup -		If a menu has been popped up via tk_popup, this
+#			gives the name of the menu.  Otherwise this
+#			value is empty.
+# postedMb -		Name of the menubutton whose menu is currently
+#			posted, or an empty string if nothing is posted
+#			A grab is set on this widget.
+# relief -		Used to save the original relief of the current
+#			menubutton.
+# window -		When the mouse is over a menu, this holds the
+#			name of the menu;  it's cleared when the mouse
+#			leaves the menu.
+# tearoff -		Whether the last menu posted was a tearoff or not.
+#			This is true always for unix, for tearoffs for Mac
+#			and Windows.
+# activeMenu -		This is the last active menu for use
+#			with the <<MenuSelect>> virtual event.
+# activeItem -		This is the last active menu item for
+#			use with the <<MenuSelect>> virtual event.
+#-------------------------------------------------------------------------
+
+#-------------------------------------------------------------------------
+# Overall note:
+# This file is tricky because there are five different ways that menus
+# can be used:
+#
+# 1. As a pulldown from a menubutton. In this style, the variable 
+#    tk::Priv(postedMb) identifies the posted menubutton.
+# 2. As a torn-off menu copied from some other menu.  In this style
+#    tk::Priv(postedMb) is empty, and menu's type is "tearoff".
+# 3. As an option menu, triggered from an option menubutton.  In this
+#    style tk::Priv(postedMb) identifies the posted menubutton.
+# 4. As a popup menu.  In this style tk::Priv(postedMb) is empty and
+#    the top-level menu's type is "normal".
+# 5. As a pulldown from a menubar. The variable tk::Priv(menubar) has
+#    the owning menubar, and the menu itself is of type "normal".
+#
+# The various binding procedures use the  state described above to
+# distinguish the various cases and take different actions in each
+# case.
+#-------------------------------------------------------------------------
+
+#-------------------------------------------------------------------------
+# The code below creates the default class bindings for menus
+# and menubuttons.
+#-------------------------------------------------------------------------
+
+bind Menubutton <FocusIn> {}
+bind Menubutton <Enter> {
+    tk::MbEnter %W
+}
+bind Menubutton <Leave> {
+    tk::MbLeave %W
+}
+bind Menubutton <1> {
+    if {$tk::Priv(inMenubutton) ne ""} {
+	tk::MbPost $tk::Priv(inMenubutton) %X %Y
+    }
+}
+bind Menubutton <Motion> {
+    tk::MbMotion %W up %X %Y
+}
+bind Menubutton <B1-Motion> {
+    tk::MbMotion %W down %X %Y
+}
+bind Menubutton <ButtonRelease-1> {
+    tk::MbButtonUp %W
+}
+bind Menubutton <space> {
+    tk::MbPost %W
+    tk::MenuFirstEntry [%W cget -menu]
+}
+
+# Must set focus when mouse enters a menu, in order to allow
+# mixed-mode processing using both the mouse and the keyboard.
+# Don't set the focus if the event comes from a grab release,
+# though:  such an event can happen after as part of unposting
+# a cascaded chain of menus, after the focus has already been
+# restored to wherever it was before menu selection started.
+
+bind Menu <FocusIn> {}
+
+bind Menu <Enter> {
+    set tk::Priv(window) %W
+    if {[%W cget -type] eq "tearoff"} {
+	if {"%m" ne "NotifyUngrab"} {
+	    if {[tk windowingsystem] eq "x11"} {
+		tk_menuSetFocus %W
+	    }
+	}
+    }
+    tk::MenuMotion %W %x %y %s
+}
+
+bind Menu <Leave> {
+    tk::MenuLeave %W %X %Y %s
+}
+bind Menu <Motion> {
+    tk::MenuMotion %W %x %y %s
+}
+bind Menu <ButtonPress> {
+    tk::MenuButtonDown %W
+}
+bind Menu <ButtonRelease> {
+   tk::MenuInvoke %W 1
+}
+bind Menu <space> {
+    tk::MenuInvoke %W 0
+}
+bind Menu <Return> {
+    tk::MenuInvoke %W 0
+}
+bind Menu <Escape> {
+    tk::MenuEscape %W
+}
+bind Menu <Left> {
+    tk::MenuLeftArrow %W
+}
+bind Menu <Right> {
+    tk::MenuRightArrow %W
+}
+bind Menu <Up> {
+    tk::MenuUpArrow %W
+}
+bind Menu <Down> {
+    tk::MenuDownArrow %W
+}
+bind Menu <KeyPress> {
+    tk::TraverseWithinMenu %W %A
+}
+
+# The following bindings apply to all windows, and are used to
+# implement keyboard menu traversal.
+
+if {[string equal [tk windowingsystem] "x11"]} {
+    bind all <Alt-KeyPress> {
+	tk::TraverseToMenu %W %A
+    }
+
+    bind all <F10> {
+	tk::FirstMenu %W
+    }
+} else {
+    bind Menubutton <Alt-KeyPress> {
+	tk::TraverseToMenu %W %A
+    }
+
+    bind Menubutton <F10> {
+	tk::FirstMenu %W
+    }
+}
+
+# ::tk::MbEnter --
+# This procedure is invoked when the mouse enters a menubutton
+# widget.  It activates the widget unless it is disabled.  Note:
+# this procedure is only invoked when mouse button 1 is *not* down.
+# The procedure ::tk::MbB1Enter is invoked if the button is down.
+#
+# Arguments:
+# w -			The  name of the widget.
+
+proc ::tk::MbEnter w {
+    variable ::tk::Priv
+
+    if {[string compare $Priv(inMenubutton) ""]} {
+	MbLeave $Priv(inMenubutton)
+    }
+    set Priv(inMenubutton) $w
+    if {[string compare [$w cget -state] "disabled"]} {
+	$w configure -state active
+    }
+}
+
+# ::tk::MbLeave --
+# This procedure is invoked when the mouse leaves a menubutton widget.
+# It de-activates the widget, if the widget still exists.
+#
+# Arguments:
+# w -			The  name of the widget.
+
+proc ::tk::MbLeave w {
+    variable ::tk::Priv
+
+    set Priv(inMenubutton) {}
+    if {![winfo exists $w]} {
+	return
+    }
+    if {[string equal [$w cget -state] "active"]} {
+	$w configure -state normal
+    }
+}
+
+# ::tk::MbPost --
+# Given a menubutton, this procedure does all the work of posting
+# its associated menu and unposting any other menu that is currently
+# posted.
+#
+# Arguments:
+# w -			The name of the menubutton widget whose menu
+#			is to be posted.
+# x, y -		Root coordinates of cursor, used for positioning
+#			option menus.  If not specified, then the center
+#			of the menubutton is used for an option menu.
+
+proc ::tk::MbPost {w {x {}} {y {}}} {
+    global errorInfo
+    variable ::tk::Priv
+    global tcl_platform
+
+    if {[$w cget -state] eq "disabled" || $w eq $Priv(postedMb)} {
+	return
+    }
+    set menu [$w cget -menu]
+    if {[string equal $menu ""]} {
+	return
+    }
+    set tearoff [expr {[tk windowingsystem] eq "x11" \
+	    || [$menu cget -type] eq "tearoff"}]
+    if {[string first $w $menu] != 0} {
+	error "can't post $menu:  it isn't a descendant of $w (this is a new requirement in Tk versions 3.0 and later)"
+    }
+    set cur $Priv(postedMb)
+    if {[string compare $cur ""]} {
+	MenuUnpost {}
+    }
+    set Priv(cursor) [$w cget -cursor]
+    set Priv(relief) [$w cget -relief]
+    $w configure -cursor arrow
+    $w configure -relief raised
+
+    set Priv(postedMb) $w
+    set Priv(focus) [focus]
+    $menu activate none
+    GenerateMenuSelect $menu
+
+    # If this looks like an option menubutton then post the menu so
+    # that the current entry is on top of the mouse.  Otherwise post
+    # the menu just below the menubutton, as for a pull-down.
+
+    update idletasks
+    if {[catch {
+	switch [$w cget -direction] {
+    	    above {
+    	    	set x [winfo rootx $w]
+    	    	set y [expr {[winfo rooty $w] - [winfo reqheight $menu]}]
+		# if we go offscreen to the top, show as 'below'
+		if {$y < 0} {
+		    set y [expr {[winfo rooty $w] + [winfo height $w]}]
+		}
+		PostOverPoint $menu $x $y
+    	    }
+    	    below {
+    	    	set x [winfo rootx $w]
+    	    	set y [expr {[winfo rooty $w] + [winfo height $w]}]
+		# if we go offscreen to the bottom, show as 'above'
+		set mh [winfo reqheight $menu]
+		if {($y + $mh) > [winfo screenheight $w]} {
+		    set y [expr {[winfo rooty $w] - $mh}]
+		}
+		PostOverPoint $menu $x $y
+    	    }
+    	    left {
+    	    	set x [expr {[winfo rootx $w] - [winfo reqwidth $menu]}]
+    	    	set y [expr {(2 * [winfo rooty $w] + [winfo height $w]) / 2}]
+    	    	set entry [MenuFindName $menu [$w cget -text]]
+    	    	if {[$w cget -indicatoron]} {
+		    if {$entry == [$menu index last]} {
+		    	incr y [expr {-([$menu yposition $entry] \
+			    	+ [winfo reqheight $menu])/2}]
+		    } else {
+		    	incr y [expr {-([$menu yposition $entry] \
+			        + [$menu yposition [expr {$entry+1}]])/2}]
+		    }
+    	    	}
+		PostOverPoint $menu $x $y
+		if {$entry ne "" \
+			&& [$menu entrycget $entry -state] ne "disabled"} {
+    	    	    $menu activate $entry
+		    GenerateMenuSelect $menu
+    	    	}
+    	    }
+    	    right {
+    	    	set x [expr {[winfo rootx $w] + [winfo width $w]}]
+    	    	set y [expr {(2 * [winfo rooty $w] + [winfo height $w]) / 2}]
+    	    	set entry [MenuFindName $menu [$w cget -text]]
+    	    	if {[$w cget -indicatoron]} {
+		    if {$entry == [$menu index last]} {
+		    	incr y [expr {-([$menu yposition $entry] \
+			    	+ [winfo reqheight $menu])/2}]
+		    } else {
+		    	incr y [expr {-([$menu yposition $entry] \
+			        + [$menu yposition [expr {$entry+1}]])/2}]
+		    }
+    	    	}
+		PostOverPoint $menu $x $y
+		if {$entry ne "" \
+			&& [$menu entrycget $entry -state] ne "disabled"} {
+    	    	    $menu activate $entry
+		    GenerateMenuSelect $menu
+    	    	}
+    	    }
+    	    default {
+    	    	if {[$w cget -indicatoron]} {
+		    if {[string equal $y {}]} {
+			set x [expr {[winfo rootx $w] + [winfo width $w]/2}]
+			set y [expr {[winfo rooty $w] + [winfo height $w]/2}]
+	    	    }
+	            PostOverPoint $menu $x $y [MenuFindName $menu [$w cget -text]]
+		} else {
+		    PostOverPoint $menu [winfo rootx $w] [expr {[winfo rooty $w]+[winfo height $w]}]
+    	    	}
+    	    }
+	}
+    } msg]} {
+	# Error posting menu (e.g. bogus -postcommand). Unpost it and
+	# reflect the error.
+	
+	set savedInfo $errorInfo
+	MenuUnpost {}
+	error $msg $savedInfo
+
+    }
+
+    set Priv(tearoff) $tearoff
+    if {$tearoff != 0} {
+    	focus $menu
+	if {[winfo viewable $w]} {
+	    SaveGrabInfo $w
+	    grab -global $w
+	}
+    }
+}
+
+# ::tk::MenuUnpost --
+# This procedure unposts a given menu, plus all of its ancestors up
+# to (and including) a menubutton, if any.  It also restores various
+# values to what they were before the menu was posted, and releases
+# a grab if there's a menubutton involved.  Special notes:
+# 1. It's important to unpost all menus before releasing the grab, so
+#    that any Enter-Leave events (e.g. from menu back to main
+#    application) have mode NotifyGrab.
+# 2. Be sure to enclose various groups of commands in "catch" so that
+#    the procedure will complete even if the menubutton or the menu
+#    or the grab window has been deleted.
+#
+# Arguments:
+# menu -		Name of a menu to unpost.  Ignored if there
+#			is a posted menubutton.
+
+proc ::tk::MenuUnpost menu {
+    global tcl_platform
+    variable ::tk::Priv
+    set mb $Priv(postedMb)
+
+    # Restore focus right away (otherwise X will take focus away when
+    # the menu is unmapped and under some window managers (e.g. olvwm)
+    # we'll lose the focus completely).
+
+    catch {focus $Priv(focus)}
+    set Priv(focus) ""
+
+    # Unpost menu(s) and restore some stuff that's dependent on
+    # what was posted.
+
+    catch {
+	if {[string compare $mb ""]} {
+	    set menu [$mb cget -menu]
+	    $menu unpost
+	    set Priv(postedMb) {}
+	    $mb configure -cursor $Priv(cursor)
+	    $mb configure -relief $Priv(relief)
+	} elseif {[string compare $Priv(popup) ""]} {
+	    $Priv(popup) unpost
+	    set Priv(popup) {}
+	} elseif {[string compare [$menu cget -type] "menubar"] \
+		&& [string compare [$menu cget -type] "tearoff"]} {
+	    # We're in a cascaded sub-menu from a torn-off menu or popup.
+	    # Unpost all the menus up to the toplevel one (but not
+	    # including the top-level torn-off one) and deactivate the
+	    # top-level torn off menu if there is one.
+
+	    while {1} {
+		set parent [winfo parent $menu]
+		if {[string compare [winfo class $parent] "Menu"] \
+			|| ![winfo ismapped $parent]} {
+		    break
+		}
+		$parent activate none
+		$parent postcascade none
+		GenerateMenuSelect $parent
+		set type [$parent cget -type]
+		if {[string equal $type "menubar"] || \
+			[string equal $type "tearoff"]} {
+		    break
+		}
+		set menu $parent
+	    }
+	    if {[string compare [$menu cget -type] "menubar"]} {
+		$menu unpost
+	    }
+	}
+    }
+
+    if {($Priv(tearoff) != 0) || $Priv(menuBar) ne ""} {
+    	# Release grab, if any, and restore the previous grab, if there
+    	# was one.
+	if {[string compare $menu ""]} {
+	    set grab [grab current $menu]
+	    if {[string compare $grab ""]} {
+		grab release $grab
+	    }
+	}
+	RestoreOldGrab
+	if {$Priv(menuBar) ne ""} {
+	    $Priv(menuBar) configure -cursor $Priv(cursor)
+	    set Priv(menuBar) {}
+	}
+	if {[tk windowingsystem] ne "x11"} {
+	    set Priv(tearoff) 0
+	}
+    }
+}
+
+# ::tk::MbMotion --
+# This procedure handles mouse motion events inside menubuttons, and
+# also outside menubuttons when a menubutton has a grab (e.g. when a
+# menu selection operation is in progress).
+#
+# Arguments:
+# w -			The name of the menubutton widget.
+# upDown - 		"down" means button 1 is pressed, "up" means
+#			it isn't.
+# rootx, rooty -	Coordinates of mouse, in (virtual?) root window.
+
+proc ::tk::MbMotion {w upDown rootx rooty} {
+    variable ::tk::Priv
+
+    if {[string equal $Priv(inMenubutton) $w]} {
+	return
+    }
+    set new [winfo containing $rootx $rooty]
+    if {[string compare $new $Priv(inMenubutton)] \
+	    && ([string equal $new ""] \
+	    || [string equal [winfo toplevel $new] [winfo toplevel $w]])} {
+	if {[string compare $Priv(inMenubutton) ""]} {
+	    MbLeave $Priv(inMenubutton)
+	}
+	if {[string compare $new ""] \
+		&& [string equal [winfo class $new] "Menubutton"] \
+		&& ([$new cget -indicatoron] == 0) \
+		&& ([$w cget -indicatoron] == 0)} {
+	    if {[string equal $upDown "down"]} {
+		MbPost $new $rootx $rooty
+	    } else {
+		MbEnter $new
+	    }
+	}
+    }
+}
+
+# ::tk::MbButtonUp --
+# This procedure is invoked to handle button 1 releases for menubuttons.
+# If the release happens inside the menubutton then leave its menu
+# posted with element 0 activated.  Otherwise, unpost the menu.
+#
+# Arguments:
+# w -			The name of the menubutton widget.
+
+proc ::tk::MbButtonUp w {
+    variable ::tk::Priv
+    global tcl_platform
+
+    set menu [$w cget -menu]
+    set tearoff [expr {[tk windowingsystem] eq "x11" || \
+	    ($menu ne "" && [$menu cget -type] eq "tearoff")}]
+    if {($tearoff != 0) && $Priv(postedMb) eq $w \
+	    && $Priv(inMenubutton) eq $w} {
+	MenuFirstEntry [$Priv(postedMb) cget -menu]
+    } else {
+	MenuUnpost {}
+    }
+}
+
+# ::tk::MenuMotion --
+# This procedure is called to handle mouse motion events for menus.
+# It does two things.  First, it resets the active element in the
+# menu, if the mouse is over the menu.  Second, if a mouse button
+# is down, it posts and unposts cascade entries to match the mouse
+# position.
+#
+# Arguments:
+# menu -		The menu window.
+# x -			The x position of the mouse.
+# y -			The y position of the mouse.
+# state -		Modifier state (tells whether buttons are down).
+
+proc ::tk::MenuMotion {menu x y state} {
+    variable ::tk::Priv
+    if {[string equal $menu $Priv(window)]} {
+	if {[string equal [$menu cget -type] "menubar"]} {
+	    if {[info exists Priv(focus)] && \
+		    [string compare $menu $Priv(focus)]} {
+		$menu activate @$x,$y
+		GenerateMenuSelect $menu
+	    }
+	} else {
+	    $menu activate @$x,$y
+	    GenerateMenuSelect $menu
+	}
+    }
+    if {($state & 0x1f00) != 0} {
+	$menu postcascade active
+    }
+}
+
+# ::tk::MenuButtonDown --
+# Handles button presses in menus.  There are a couple of tricky things
+# here:
+# 1. Change the posted cascade entry (if any) to match the mouse position.
+# 2. If there is a posted menubutton, must grab to the menubutton;  this
+#    overrrides the implicit grab on button press, so that the menu
+#    button can track mouse motions over other menubuttons and change
+#    the posted menu.
+# 3. If there's no posted menubutton (e.g. because we're a torn-off menu
+#    or one of its descendants) must grab to the top-level menu so that
+#    we can track mouse motions across the entire menu hierarchy.
+#
+# Arguments:
+# menu -		The menu window.
+
+proc ::tk::MenuButtonDown menu {
+    variable ::tk::Priv
+    global tcl_platform
+
+    if {![winfo viewable $menu]} {
+        return
+    }
+    $menu postcascade active
+    if {[string compare $Priv(postedMb) ""] && \
+	    [winfo viewable $Priv(postedMb)]} {
+	grab -global $Priv(postedMb)
+    } else {
+	while {[string equal [$menu cget -type] "normal"] \
+		&& [string equal [winfo class [winfo parent $menu]] "Menu"] \
+		&& [winfo ismapped [winfo parent $menu]]} {
+	    set menu [winfo parent $menu]
+	}
+
+	if {[string equal $Priv(menuBar) {}]} {
+	    set Priv(menuBar) $menu
+	    set Priv(cursor) [$menu cget -cursor]
+	    $menu configure -cursor arrow
+        }
+
+	# Don't update grab information if the grab window isn't changing.
+	# Otherwise, we'll get an error when we unpost the menus and
+	# restore the grab, since the old grab window will not be viewable
+	# anymore.
+
+	if {[string compare $menu [grab current $menu]]} {
+	    SaveGrabInfo $menu
+	}
+
+	# Must re-grab even if the grab window hasn't changed, in order
+	# to release the implicit grab from the button press.
+
+	if {[string equal [tk windowingsystem] "x11"]} {
+	    grab -global $menu
+	}
+    }
+}
+
+# ::tk::MenuLeave --
+# This procedure is invoked to handle Leave events for a menu.  It
+# deactivates everything unless the active element is a cascade element
+# and the mouse is now over the submenu.
+#
+# Arguments:
+# menu -		The menu window.
+# rootx, rooty -	Root coordinates of mouse.
+# state -		Modifier state.
+
+proc ::tk::MenuLeave {menu rootx rooty state} {
+    variable ::tk::Priv
+    set Priv(window) {}
+    if {[string equal [$menu index active] "none"]} {
+	return
+    }
+    if {[string equal [$menu type active] "cascade"]
+          && [string equal [winfo containing $rootx $rooty] \
+                  [$menu entrycget active -menu]]} {
+	return
+    }
+    $menu activate none
+    GenerateMenuSelect $menu
+}
+
+# ::tk::MenuInvoke --
+# This procedure is invoked when button 1 is released over a menu.
+# It invokes the appropriate menu action and unposts the menu if
+# it came from a menubutton.
+#
+# Arguments:
+# w -			Name of the menu widget.
+# buttonRelease -	1 means this procedure is called because of
+#			a button release;  0 means because of keystroke.
+
+proc ::tk::MenuInvoke {w buttonRelease} {
+    variable ::tk::Priv
+
+    if {$buttonRelease && [string equal $Priv(window) {}]} {
+	# Mouse was pressed over a menu without a menu button, then
+	# dragged off the menu (possibly with a cascade posted) and
+	# released.  Unpost everything and quit.
+
+	$w postcascade none
+	$w activate none
+	event generate $w <<MenuSelect>>
+	MenuUnpost $w
+	return
+    }
+    if {[string equal [$w type active] "cascade"]} {
+	$w postcascade active
+	set menu [$w entrycget active -menu]
+	MenuFirstEntry $menu
+    } elseif {[string equal [$w type active] "tearoff"]} {
+	::tk::TearOffMenu $w
+	MenuUnpost $w
+    } elseif {[string equal [$w cget -type] "menubar"]} {
+	$w postcascade none
+	set active [$w index active]
+	set isCascade [string equal [$w type $active] "cascade"]
+
+	# Only de-activate the active item if it's a cascade; this prevents
+	# the annoying "activation flicker" you otherwise get with 
+	# checkbuttons/commands/etc. on menubars
+
+	if { $isCascade } {
+	    $w activate none
+	    event generate $w <<MenuSelect>>
+	}
+
+	MenuUnpost $w
+
+	# If the active item is not a cascade, invoke it.  This enables
+	# the use of checkbuttons/commands/etc. on menubars (which is legal,
+	# but not recommended)
+
+	if { !$isCascade } {
+	    uplevel #0 [list $w invoke $active]
+	}
+    } else {
+	set active [$w index active]
+	if {$Priv(popup) eq "" || $active ne "none"} {
+	    MenuUnpost $w
+	}
+	uplevel #0 [list $w invoke active]
+    }
+}
+
+# ::tk::MenuEscape --
+# This procedure is invoked for the Cancel (or Escape) key.  It unposts
+# the given menu and, if it is the top-level menu for a menu button,
+# unposts the menu button as well.
+#
+# Arguments:
+# menu -		Name of the menu window.
+
+proc ::tk::MenuEscape menu {
+    set parent [winfo parent $menu]
+    if {[string compare [winfo class $parent] "Menu"]} {
+	MenuUnpost $menu
+    } elseif {[string equal [$parent cget -type] "menubar"]} {
+	MenuUnpost $menu
+	RestoreOldGrab
+    } else {
+	MenuNextMenu $menu left
+    }
+}
+
+# The following routines handle arrow keys. Arrow keys behave
+# differently depending on whether the menu is a menu bar or not.
+
+proc ::tk::MenuUpArrow {menu} {
+    if {[string equal [$menu cget -type] "menubar"]} {
+	MenuNextMenu $menu left
+    } else {
+	MenuNextEntry $menu -1
+    }
+}
+
+proc ::tk::MenuDownArrow {menu} {
+    if {[string equal [$menu cget -type] "menubar"]} {
+	MenuNextMenu $menu right
+    } else {
+	MenuNextEntry $menu 1
+    }
+}
+
+proc ::tk::MenuLeftArrow {menu} {
+    if {[string equal [$menu cget -type] "menubar"]} {
+	MenuNextEntry $menu -1
+    } else {
+	MenuNextMenu $menu left
+    }
+}
+
+proc ::tk::MenuRightArrow {menu} {
+    if {[string equal [$menu cget -type] "menubar"]} {
+	MenuNextEntry $menu 1
+    } else {
+	MenuNextMenu $menu right
+    }
+}
+
+# ::tk::MenuNextMenu --
+# This procedure is invoked to handle "left" and "right" traversal
+# motions in menus.  It traverses to the next menu in a menu bar,
+# or into or out of a cascaded menu.
+#
+# Arguments:
+# menu -		The menu that received the keyboard
+#			event.
+# direction -		Direction in which to move: "left" or "right"
+
+proc ::tk::MenuNextMenu {menu direction} {
+    variable ::tk::Priv
+
+    # First handle traversals into and out of cascaded menus.
+
+    if {[string equal $direction "right"]} {
+	set count 1
+	set parent [winfo parent $menu]
+	set class [winfo class $parent]
+	if {[string equal [$menu type active] "cascade"]} {
+	    $menu postcascade active
+	    set m2 [$menu entrycget active -menu]
+	    if {[string compare $m2 ""]} {
+		MenuFirstEntry $m2
+	    }
+	    return
+	} else {
+	    set parent [winfo parent $menu]
+	    while {[string compare $parent "."]} {
+		if {[string equal [winfo class $parent] "Menu"] \
+			&& [string equal [$parent cget -type] "menubar"]} {
+		    tk_menuSetFocus $parent
+		    MenuNextEntry $parent 1
+		    return
+		}
+		set parent [winfo parent $parent]
+	    }
+	}
+    } else {
+	set count -1
+	set m2 [winfo parent $menu]
+	if {[string equal [winfo class $m2] "Menu"]} {
+	    $menu activate none
+	    GenerateMenuSelect $menu
+	    tk_menuSetFocus $m2
+
+	    $m2 postcascade none
+
+	    if {[string compare [$m2 cget -type] "menubar"]} {
+		return
+	    }
+	}
+    }
+
+    # Can't traverse into or out of a cascaded menu.  Go to the next
+    # or previous menubutton, if that makes sense.
+
+    set m2 [winfo parent $menu]
+    if {[string equal [winfo class $m2] "Menu"]} {
+	if {[string equal [$m2 cget -type] "menubar"]} {
+	    tk_menuSetFocus $m2
+	    MenuNextEntry $m2 -1
+	    return
+	}
+    }
+
+    set w $Priv(postedMb)
+    if {[string equal $w ""]} {
+	return
+    }
+    set buttons [winfo children [winfo parent $w]]
+    set length [llength $buttons]
+    set i [expr {[lsearch -exact $buttons $w] + $count}]
+    while {1} {
+	while {$i < 0} {
+	    incr i $length
+	}
+	while {$i >= $length} {
+	    incr i -$length
+	}
+	set mb [lindex $buttons $i]
+	if {[string equal [winfo class $mb] "Menubutton"] \
+		&& [string compare [$mb cget -state] "disabled"] \
+		&& [string compare [$mb cget -menu] ""] \
+		&& [string compare [[$mb cget -menu] index last] "none"]} {
+	    break
+	}
+	if {[string equal $mb $w]} {
+	    return
+	}
+	incr i $count
+    }
+    MbPost $mb
+    MenuFirstEntry [$mb cget -menu]
+}
+
+# ::tk::MenuNextEntry --
+# Activate the next higher or lower entry in the posted menu,
+# wrapping around at the ends.  Disabled entries are skipped.
+#
+# Arguments:
+# menu -			Menu window that received the keystroke.
+# count -			1 means go to the next lower entry,
+#				-1 means go to the next higher entry.
+
+proc ::tk::MenuNextEntry {menu count} {
+
+    if {[string equal [$menu index last] "none"]} {
+	return
+    }
+    set length [expr {[$menu index last]+1}]
+    set quitAfter $length
+    set active [$menu index active]
+    if {[string equal $active "none"]} {
+	set i 0
+    } else {
+	set i [expr {$active + $count}]
+    }
+    while {1} {
+	if {$quitAfter <= 0} {
+	    # We've tried every entry in the menu.  Either there are
+	    # none, or they're all disabled.  Just give up.
+
+	    return
+	}
+	while {$i < 0} {
+	    incr i $length
+	}
+	while {$i >= $length} {
+	    incr i -$length
+	}
+	if {[catch {$menu entrycget $i -state} state] == 0} {
+	    if {$state ne "disabled" && \
+		    ($i!=0 || [$menu cget -type] ne "tearoff" \
+		    || [$menu type 0] ne "tearoff")} {
+		break
+	    }
+	}
+	if {$i == $active} {
+	    return
+	}
+	incr i $count
+	incr quitAfter -1
+    }
+    $menu activate $i
+    GenerateMenuSelect $menu
+
+    if {[string equal [$menu type $i] "cascade"] \
+	    && [string equal [$menu cget -type] "menubar"]} {
+	set cascade [$menu entrycget $i -menu]
+	if {[string compare $cascade ""]} {
+	    # Here we auto-post a cascade.  This is necessary when
+	    # we traverse left/right in the menubar, but undesirable when
+	    # we traverse up/down in a menu.
+	    $menu postcascade $i
+	    MenuFirstEntry $cascade
+	}
+    }
+}
+
+# ::tk::MenuFind --
+# This procedure searches the entire window hierarchy under w for
+# a menubutton that isn't disabled and whose underlined character
+# is "char" or an entry in a menubar that isn't disabled and whose
+# underlined character is "char".
+# It returns the name of that window, if found, or an
+# empty string if no matching window was found.  If "char" is an
+# empty string then the procedure returns the name of the first
+# menubutton found that isn't disabled.
+#
+# Arguments:
+# w -				Name of window where key was typed.
+# char -			Underlined character to search for;
+#				may be either upper or lower case, and
+#				will match either upper or lower case.
+
+proc ::tk::MenuFind {w char} {
+    set char [string tolower $char]
+    set windowlist [winfo child $w]
+
+    foreach child $windowlist {
+	# Don't descend into other toplevels.
+        if {[string compare [winfo toplevel $w] [winfo toplevel $child]]} {
+	    continue
+	}
+	if {[string equal [winfo class $child] "Menu"] && \
+		[string equal [$child cget -type] "menubar"]} {
+	    if {[string equal $char ""]} {
+		return $child
+	    }
+	    set last [$child index last]
+	    for {set i [$child cget -tearoff]} {$i <= $last} {incr i} {
+		if {[string equal [$child type $i] "separator"]} {
+		    continue
+		}
+		set char2 [string index [$child entrycget $i -label] \
+			[$child entrycget $i -underline]]
+		if {[string equal $char [string tolower $char2]] \
+			|| [string equal $char ""]} {
+		    if {[string compare [$child entrycget $i -state] "disabled"]} {
+			return $child
+		    }
+		}
+	    }
+	}
+    }
+
+    foreach child $windowlist {
+	# Don't descend into other toplevels.
+        if {[string compare [winfo toplevel $w] [winfo toplevel $child]]} {
+	    continue
+	}
+	switch [winfo class $child] {
+	    Menubutton {
+		set char2 [string index [$child cget -text] \
+			[$child cget -underline]]
+		if {[string equal $char [string tolower $char2]] \
+			|| [string equal $char ""]} {
+		    if {[string compare [$child cget -state] "disabled"]} {
+			return $child
+		    }
+		}
+	    }
+
+	    default {
+		set match [MenuFind $child $char]
+		if {[string compare $match ""]} {
+		    return $match
+		}
+	    }
+	}
+    }
+    return {}
+}
+
+# ::tk::TraverseToMenu --
+# This procedure implements keyboard traversal of menus.  Given an
+# ASCII character "char", it looks for a menubutton with that character
+# underlined.  If one is found, it posts the menubutton's menu
+#
+# Arguments:
+# w -				Window in which the key was typed (selects
+#				a toplevel window).
+# char -			Character that selects a menu.  The case
+#				is ignored.  If an empty string, nothing
+#				happens.
+
+proc ::tk::TraverseToMenu {w char} {
+    variable ::tk::Priv
+    if {[string equal $char ""]} {
+	return
+    }
+    while {[string equal [winfo class $w] "Menu"]} {
+	if {[string compare [$w cget -type] "menubar"] \
+		&& [string equal $Priv(postedMb) ""]} {
+	    return
+	}
+	if {[string equal [$w cget -type] "menubar"]} {
+	    break
+	}
+	set w [winfo parent $w]
+    }
+    set w [MenuFind [winfo toplevel $w] $char]
+    if {[string compare $w ""]} {
+	if {[string equal [winfo class $w] "Menu"]} {
+	    tk_menuSetFocus $w
+	    set Priv(window) $w
+	    SaveGrabInfo $w
+	    grab -global $w
+	    TraverseWithinMenu $w $char
+	} else {
+	    MbPost $w
+	    MenuFirstEntry [$w cget -menu]
+	}
+    }
+}
+
+# ::tk::FirstMenu --
+# This procedure traverses to the first menubutton in the toplevel
+# for a given window, and posts that menubutton's menu.
+#
+# Arguments:
+# w -				Name of a window.  Selects which toplevel
+#				to search for menubuttons.
+
+proc ::tk::FirstMenu w {
+    variable ::tk::Priv
+    set w [MenuFind [winfo toplevel $w] ""]
+    if {[string compare $w ""]} {
+	if {[string equal [winfo class $w] "Menu"]} {
+	    tk_menuSetFocus $w
+	    set Priv(window) $w
+	    SaveGrabInfo $w
+	    grab -global $w
+	    MenuFirstEntry $w
+	} else {
+	    MbPost $w
+	    MenuFirstEntry [$w cget -menu]
+	}
+    }
+}
+
+# ::tk::TraverseWithinMenu
+# This procedure implements keyboard traversal within a menu.  It
+# searches for an entry in the menu that has "char" underlined.  If
+# such an entry is found, it is invoked and the menu is unposted.
+#
+# Arguments:
+# w -				The name of the menu widget.
+# char -			The character to look for;  case is
+#				ignored.  If the string is empty then
+#				nothing happens.
+
+proc ::tk::TraverseWithinMenu {w char} {
+    if {[string equal $char ""]} {
+	return
+    }
+    set char [string tolower $char]
+    set last [$w index last]
+    if {[string equal $last "none"]} {
+	return
+    }
+    for {set i 0} {$i <= $last} {incr i} {
+	if {[catch {set char2 [string index \
+		[$w entrycget $i -label] [$w entrycget $i -underline]]}]} {
+	    continue
+	}
+	if {[string equal $char [string tolower $char2]]} {
+	    if {[string equal [$w type $i] "cascade"]} {
+		$w activate $i
+		$w postcascade active
+		event generate $w <<MenuSelect>>
+		set m2 [$w entrycget $i -menu]
+		if {[string compare $m2 ""]} {
+		    MenuFirstEntry $m2
+		}
+	    } else {
+		MenuUnpost $w
+		uplevel #0 [list $w invoke $i]
+	    }
+	    return
+	}
+    }
+}
+
+# ::tk::MenuFirstEntry --
+# Given a menu, this procedure finds the first entry that isn't
+# disabled or a tear-off or separator, and activates that entry.
+# However, if there is already an active entry in the menu (e.g.,
+# because of a previous call to tk::PostOverPoint) then the active
+# entry isn't changed.  This procedure also sets the input focus
+# to the menu.
+#
+# Arguments:
+# menu -		Name of the menu window (possibly empty).
+
+proc ::tk::MenuFirstEntry menu {
+    if {[string equal $menu ""]} {
+	return
+    }
+    tk_menuSetFocus $menu
+    if {[string compare [$menu index active] "none"]} {
+	return
+    }
+    set last [$menu index last]
+    if {[string equal $last "none"]} {
+	return
+    }
+    for {set i 0} {$i <= $last} {incr i} {
+	if {([catch {set state [$menu entrycget $i -state]}] == 0) \
+		&& [string compare $state "disabled"] \
+		&& [string compare [$menu type $i] "tearoff"]} {
+	    $menu activate $i
+	    GenerateMenuSelect $menu
+	    # Only post the cascade if the current menu is a menubar;
+	    # otherwise, if the first entry of the cascade is a cascade,
+	    # we can get an annoying cascading effect resulting in a bunch of
+	    # menus getting posted (bug 676)
+	    if {[string equal [$menu type $i] "cascade"] && \
+		[string equal [$menu cget -type] "menubar"]} {
+		set cascade [$menu entrycget $i -menu]
+		if {[string compare $cascade ""]} {
+		    $menu postcascade $i
+		    MenuFirstEntry $cascade
+		}
+	    }
+	    return
+	}
+    }
+}
+
+# ::tk::MenuFindName --
+# Given a menu and a text string, return the index of the menu entry
+# that displays the string as its label.  If there is no such entry,
+# return an empty string.  This procedure is tricky because some names
+# like "active" have a special meaning in menu commands, so we can't
+# always use the "index" widget command.
+#
+# Arguments:
+# menu -		Name of the menu widget.
+# s -			String to look for.
+
+proc ::tk::MenuFindName {menu s} {
+    set i ""
+    if {![regexp {^active$|^last$|^none$|^[0-9]|^@} $s]} {
+	catch {set i [$menu index $s]}
+	return $i
+    }
+    set last [$menu index last]
+    if {[string equal $last "none"]} {
+	return
+    }
+    for {set i 0} {$i <= $last} {incr i} {
+	if {![catch {$menu entrycget $i -label} label]} {
+	    if {[string equal $label $s]} {
+		return $i
+	    }
+	}
+    }
+    return ""
+}
+
+# ::tk::PostOverPoint --
+# This procedure posts a given menu such that a given entry in the
+# menu is centered over a given point in the root window.  It also
+# activates the given entry.
+#
+# Arguments:
+# menu -		Menu to post.
+# x, y -		Root coordinates of point.
+# entry -		Index of entry within menu to center over (x,y).
+#			If omitted or specified as {}, then the menu's
+#			upper-left corner goes at (x,y).
+
+proc ::tk::PostOverPoint {menu x y {entry {}}}  {
+    global tcl_platform
+    
+    if {$entry ne ""} {
+	if {$entry == [$menu index last]} {
+	    incr y [expr {-([$menu yposition $entry] \
+		    + [winfo reqheight $menu])/2}]
+	} else {
+	    incr y [expr {-([$menu yposition $entry] \
+		    + [$menu yposition [expr {$entry+1}]])/2}]
+	}
+	incr x [expr {-[winfo reqwidth $menu]/2}]
+    }
+    if {$tcl_platform(platform) eq "windows"} {
+	# We need to fix some problems with menu posting on Windows,
+	# where, if the menu would overlap top or bottom of screen,
+	# Windows puts it in the wrong place for us.  We must also
+	# subtract an extra amount for half the height of the current
+	# entry.  To be safe we subtract an extra 10.
+	set yoffset [expr {[winfo screenheight $menu] \
+		- $y - [winfo reqheight $menu] - 10}]
+	if {$yoffset < 0} {
+	    # The bottom of the menu is offscreen, so adjust upwards
+	    incr y $yoffset
+	    if {$y < 0} { set y 0 }
+	}
+	# If we're off the top of the screen (either because we were
+	# originally or because we just adjusted too far upwards),
+	# then make the menu popup on the top edge.
+	if {$y < 0} {
+	    set y 0
+	}
+    }
+    $menu post $x $y
+    if {$entry ne "" && [$menu entrycget $entry -state] ne "disabled"} {
+	$menu activate $entry
+	GenerateMenuSelect $menu
+    }
+}
+
+# ::tk::SaveGrabInfo --
+# Sets the variables tk::Priv(oldGrab) and tk::Priv(grabStatus) to record
+# the state of any existing grab on the w's display.
+#
+# Arguments:
+# w -			Name of a window;  used to select the display
+#			whose grab information is to be recorded.
+
+proc tk::SaveGrabInfo w {
+    variable ::tk::Priv
+    set Priv(oldGrab) [grab current $w]
+    if {$Priv(oldGrab) ne ""} {
+	set Priv(grabStatus) [grab status $Priv(oldGrab)]
+    }
+}
+
+# ::tk::RestoreOldGrab --
+# Restores the grab to what it was before TkSaveGrabInfo was called.
+#
+
+proc ::tk::RestoreOldGrab {} {
+    variable ::tk::Priv
+
+    if {$Priv(oldGrab) ne ""} {
+    	# Be careful restoring the old grab, since it's window may not
+	# be visible anymore.
+
+	catch {
+          if {[string equal $Priv(grabStatus) "global"]} {
+		grab set -global $Priv(oldGrab)
+	    } else {
+		grab set $Priv(oldGrab)
+	    }
+	}
+	set Priv(oldGrab) ""
+    }
+}
+
+proc ::tk_menuSetFocus {menu} {
+    variable ::tk::Priv
+    if {![info exists Priv(focus)] || [string equal $Priv(focus) {}]} {
+	set Priv(focus) [focus]
+    }
+    focus $menu
+}
+
+proc ::tk::GenerateMenuSelect {menu} {
+    variable ::tk::Priv
+
+    if {[string equal $Priv(activeMenu) $menu] \
+          && [string equal $Priv(activeItem) [$menu index active]]} {
+	return
+    }
+
+    set Priv(activeMenu) $menu
+    set Priv(activeItem) [$menu index active]
+    event generate $menu <<MenuSelect>>
+}
+
+# ::tk_popup --
+# This procedure pops up a menu and sets things up for traversing
+# the menu and its submenus.
+#
+# Arguments:
+# menu -		Name of the menu to be popped up.
+# x, y -		Root coordinates at which to pop up the
+#			menu.
+# entry -		Index of a menu entry to center over (x,y).
+#			If omitted or specified as {}, then menu's
+#			upper-left corner goes at (x,y).
+
+proc ::tk_popup {menu x y {entry {}}} {
+    variable ::tk::Priv
+    global tcl_platform
+    if {$Priv(popup) ne "" || $Priv(postedMb) ne ""} {
+	tk::MenuUnpost {}
+    }
+    tk::PostOverPoint $menu $x $y $entry
+    if {[tk windowingsystem] eq "x11" && [winfo viewable $menu]} {
+        tk::SaveGrabInfo $menu
+	grab -global $menu
+	set Priv(popup) $menu
+	tk_menuSetFocus $menu
+    }
+}