# top-level torn off menu if there is one.	    while 1 {		set parent [winfo parent $menu]		if {([winfo class $parent] != "Menu")			|| ![winfo ismapped $parent]} {		    break		}		$parent activate none		$parent postcascade none		event generate $parent <<MenuSelect>>		if {([$parent cget -type] == "menubar")		        || ![wm overrideredirect $parent]} {		    break		}		set menu $parent	    }	    if {[$menu cget -type] != "menubar"} {		$menu unpost	    }	}    }    if {($tkPriv(tearoff) != 0) || ($tkPriv(menuBar) != "")} {    	# Release grab, if any, and restore the previous grab, if there    	# was one.	if {$menu != ""} {	    set grab [grab current $menu]	    if {$grab != ""} {		grab release $grab	    }	}	tkRestoreOldGrab	if {$tkPriv(menuBar) != ""} {	    $tkPriv(menuBar) configure -cursor $tkPriv(cursor)	    set tkPriv(menuBar) {}	}	if {$tcl_platform(platform) != "unix"} {	    set tkPriv(tearoff) 0	}    }}# tkMbMotion --# 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 tkMbMotion {w upDown rootx rooty} {    global tkPriv    if {$tkPriv(inMenubutton) == $w} {	return    }    set new [winfo containing $rootx $rooty]    if {($new != $tkPriv(inMenubutton)) && (($new == "")	    || ([winfo toplevel $new] == [winfo toplevel $w]))} {	if {$tkPriv(inMenubutton) != ""} {	    tkMbLeave $tkPriv(inMenubutton)	}	if {($new != "") && ([winfo class $new] == "Menubutton")		&& ([$new cget -indicatoron] == 0)		&& ([$w cget -indicatoron] == 0)} {	    if {$upDown == "down"} {		tkMbPost $new $rootx $rooty	    } else {		tkMbEnter $new	    }	}    }}# tkMbButtonUp --# 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 tkMbButtonUp w {    global tkPriv    global tcl_platform    set tearoff [expr {($tcl_platform(platform) == "unix") \		     || ([[$w cget -menu] cget -type] == "tearoff")}]    if {($tearoff != 0) && ($tkPriv(postedMb) == $w) 	    && ($tkPriv(inMenubutton) == $w)} {	tkMenuFirstEntry [$tkPriv(postedMb) cget -menu]    } else {	tkMenuUnpost {}    }}# tkMenuMotion --# 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 tkMenuMotion {menu x y state} {    global tkPriv    if {$menu == $tkPriv(window)} {	if {[$menu cget -type] == "menubar"} {	    if {[info exists tkPriv(focus)] && \		    ([string compare $menu $tkPriv(focus)] != 0)} {		$menu activate @$x,$y		event generate $menu <<MenuSelect>>	    }	} else {	    $menu activate @$x,$y	    event generate $menu <<MenuSelect>>	}    }    if {($state & 0x1f00) != 0} {	$menu postcascade active    }}# tkMenuButtonDown --# 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 tkMenuButtonDown menu {    global tkPriv    global tcl_platform    $menu postcascade active    if {$tkPriv(postedMb) != ""} {	grab -global $tkPriv(postedMb)    } else {	while {(([$menu cget -type] != "menubar") 		&& [wm overrideredirect $menu])		&& ([winfo class [winfo parent $menu]] == "Menu")		&& [winfo ismapped [winfo parent $menu]]} {	    set menu [winfo parent $menu]	}	if {$tkPriv(menuBar) == {}} {	    set tkPriv(menuBar) $menu	    set tkPriv(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 {$menu != [grab current $menu]} {	    tkSaveGrabInfo $menu	}	# Must re-grab even if the grab window hasn't changed, in order	# to release the implicit grab from the button press.	if {$tcl_platform(platform) == "unix"} {	    grab -global $menu	}    }}# tkMenuLeave --# 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 tkMenuLeave {menu rootx rooty state} {    global tkPriv    set tkPriv(window) {}    if {[$menu index active] == "none"} {	return    }    if {([$menu type active] == "cascade")	    && ([winfo containing $rootx $rooty]	    == [$menu entrycget active -menu])} {	return    }    $menu activate none    event generate $menu <<MenuSelect>>}# tkMenuInvoke --# 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 tkMenuInvoke {w buttonRelease} {    global tkPriv    if {$buttonRelease && ($tkPriv(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>>	tkMenuUnpost $w	return    }    if {[$w type active] == "cascade"} {	$w postcascade active	set menu [$w entrycget active -menu]	tkMenuFirstEntry $menu    } elseif {[$w type active] == "tearoff"} {	tkMenuUnpost $w	tkTearOffMenu $w    } elseif {[$w cget -type] == "menubar"} {	$w postcascade none	$w activate none	event generate $w <<MenuSelect>>	tkMenuUnpost $w    } else {	tkMenuUnpost $w	uplevel #0 [list $w invoke active]    }}# tkMenuEscape --# 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 tkMenuEscape menu {    set parent [winfo parent $menu]    if {([winfo class $parent] != "Menu")} {	tkMenuUnpost $menu    } elseif {([$parent cget -type] == "menubar")} {	tkMenuUnpost $menu	tkRestoreOldGrab    } else {	tkMenuNextMenu $menu left    }}# The following routines handle arrow keys. Arrow keys behave# differently depending on whether the menu is a menu bar or not.proc tkMenuUpArrow {menu} {    if {[$menu cget -type] == "menubar"} {	tkMenuNextMenu $menu left    } else {	tkMenuNextEntry $menu -1    }}proc tkMenuDownArrow {menu} {    if {[$menu cget -type] == "menubar"} {	tkMenuNextMenu $menu right    } else {	tkMenuNextEntry $menu 1    }}proc tkMenuLeftArrow {menu} {    if {[$menu cget -type] == "menubar"} {	tkMenuNextEntry $menu -1    } else {	tkMenuNextMenu $menu left    }}proc tkMenuRightArrow {menu} {    if {[$menu cget -type] == "menubar"} {	tkMenuNextEntry $menu 1    } else {	tkMenuNextMenu $menu right    }}# tkMenuNextMenu --# 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 tkMenuNextMenu {menu direction} {    global tkPriv    # First handle traversals into and out of cascaded menus.    if {$direction == "right"} {	set count 1	set parent [winfo parent $menu]	set class [winfo class $parent]	if {[$menu type active] == "cascade"} {	    $menu postcascade active	    set m2 [$menu entrycget active -menu]	    if {$m2 != ""} {		tkMenuFirstEntry $m2	    }	    return	} else {	    set parent [winfo parent $menu]	    while {($parent != ".")} {		if {([winfo class $parent] == "Menu")			&& ([$parent cget -type] == "menubar")} {		    tk_menuSetFocus $parent		    tkMenuNextEntry $parent 1		    return		}		set parent [winfo parent $parent]	    }	}    } else {	set count -1	set m2 [winfo parent $menu]	if {[winfo class $m2] == "Menu"} {	    $menu activate none	    event generate $menu <<MenuSelect>>	    tk_menuSetFocus $m2	    # This code unposts any posted submenu in the parent.	    set tmp [$m2 index active]	    $m2 activate none	    $m2 activate $tmp	    return	}    }    # Can't traverse into or out of a cascaded menu.  Go to the next    # or previous menubutton, if that makes sense.    set w $tkPriv(postedMb)    if {$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 {([winfo class $mb] == "Menubutton")		&& ([$mb cget -state] != "disabled")		&& ([$mb cget -menu] != "")		&& ([[$mb cget -menu] index last] != "none")} {	    break	}	if {$mb == $w} {	    return	}	incr i $count    }    tkMbPost $mb    tkMenuFirstEntry [$mb cget -menu]}# tkMenuNextEntry --# Activate the next higher or lower entry in the posted menu,