# 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 tkMenuNextEntry {menu count} {    global tkPriv    if {[$menu index last] == "none"} {	return    }    set length [expr [$menu index last]+1]    set quitAfter $length    set active [$menu index active]    if {$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 != "disabled"} {		break	    }	}	if {$i == $active} {	    return	}	incr i $count	incr quitAfter -1    }    $menu activate $i    event generate $menu <<MenuSelect>>    $menu postcascade $i}# tkMenuFind --# 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 tkMenuFind {w char} {    global tkPriv    set char [string tolower $char]    set windowlist [winfo child $w]    foreach child $windowlist {	switch [winfo class $child] {	    Menu {		if {[$child cget -type] == "menubar"} {		    if {$char == ""} {			return $child		    }		    set last [$child index last]		    for {set i [$child cget -tearoff]} {$i <= $last} {incr i} {			set char2 [string index [$child entrycget $i -label] \				[$child entrycget $i -underline]]			if {([string compare $char [string tolower $char2]] \				== 0) || ($char == "")} {			    if {[$child entrycget $i -state] != "disabled"} {				return $child			    }			}		    }		}	    }	}    }    foreach child $windowlist {	switch [winfo class $child] {	    Menubutton {		set char2 [string index [$child cget -text] \			[$child cget -underline]]		if {([string compare $char [string tolower $char2]] == 0)			|| ($char == "")} {		    if {[$child cget -state] != "disabled"} {			return $child		    }		}	    }	    default {		set match [tkMenuFind $child $char]		if {$match != ""} {		    return $match		}	    }	}    }    return {}}# tkTraverseToMenu --# 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 tkTraverseToMenu {w char} {    global tkPriv    if {$char == ""} {	return    }    while {[winfo class $w] == "Menu"} {	if {([$w cget -type] != "menubar") && ($tkPriv(postedMb) == "")} {	    return	}	if {[$w cget -type] == "menubar"} {	    break	}	set w [winfo parent $w]    }    set w [tkMenuFind [winfo toplevel $w] $char]    if {$w != ""} {	if {[winfo class $w] == "Menu"} {	    tk_menuSetFocus $w	    set tkPriv(window) $w	    tkSaveGrabInfo $w	    grab -global $w	    tkTraverseWithinMenu $w $char	} else {	    tkMbPost $w	    tkMenuFirstEntry [$w cget -menu]	}    }}# tkFirstMenu --# 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 tkFirstMenu w {    set w [tkMenuFind [winfo toplevel $w] ""]    if {$w != ""} {	if {[winfo class $w] == "Menu"} {	    tk_menuSetFocus $w	    set tkPriv(window) $w	    tkSaveGrabInfo $w	    grab -global $w	    tkMenuFirstEntry $w	} else {	    tkMbPost $w	    tkMenuFirstEntry [$w cget -menu]	}    }}# tkTraverseWithinMenu# 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 tkTraverseWithinMenu {w char} {    if {$char == ""} {	return    }    set char [string tolower $char]    set last [$w index last]    if {$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 compare $char [string tolower $char2]] == 0} {	    if {[$w type $i] == "cascade"} {		$w activate $i		$w postcascade active		event generate $w <<MenuSelect>>		set m2 [$w entrycget $i -menu]		if {$m2 != ""} {		    tkMenuFirstEntry $m2		}	    } else {		tkMenuUnpost $w		uplevel #0 [list $w invoke $i]	    }	    return	}    }}# tkMenuFirstEntry --# 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 tkPostOverPoint) 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 tkMenuFirstEntry menu {    if {$menu == ""} {	return    }    tk_menuSetFocus $menu    if {[$menu index active] != "none"} {	return    }    set last [$menu index last]    if {$last == "none"} {	return    }    for {set i 0} {$i <= $last} {incr i} {	if {([catch {set state [$menu entrycget $i -state]}] == 0)		&& ($state != "disabled") && ([$menu type $i] != "tearoff")} {	    $menu activate $i	    event generate $menu <<MenuSelect>>	    return	}    }}# tkMenuFindName --# 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 tkMenuFindName {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 {$last == "none"} {	return    }    for {set i 0} {$i <= $last} {incr i} {	if ![catch {$menu entrycget $i -label} label] {	    if {$label == $s} {		return $i	    }	}    }    return ""}# tkPostOverPoint --# 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 tkPostOverPoint {menu x y {entry {}}}  {    global tcl_platform        if {$entry != {}} {	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]    }    $menu post $x $y    if {($entry != {}) && ([$menu entrycget $entry -state] != "disabled")} {	$menu activate $entry	event generate $menu <<MenuSelect>>    }}# tkSaveGrabInfo --# Sets the variables tkPriv(oldGrab) and tkPriv(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 tkSaveGrabInfo w {    global tkPriv    set tkPriv(oldGrab) [grab current $w]    if {$tkPriv(oldGrab) != ""} {	set tkPriv(grabStatus) [grab status $tkPriv(oldGrab)]    }}# tkRestoreOldGrab --# Restores the grab to what it was before TkSaveGrabInfo was called.#proc tkRestoreOldGrab {} {    global tkPriv    if {$tkPriv(oldGrab) != ""} {    	# Be careful restoring the old grab, since it's window may not	# be visible anymore.	catch {	    if {$tkPriv(grabStatus) == "global"} {		grab set -global $tkPriv(oldGrab)	    } else {		grab set $tkPriv(oldGrab)	    }	}	set tkPriv(oldGrab) ""    }}proc tk_menuSetFocus {menu} {    global tkPriv    if {![info exists tkPriv(focus)] || [string length $tkPriv(focus)] == 0} {	set tkPriv(focus) [focus]    }    focus $menu}    # 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 {}}} {    global tkPriv    global tcl_platform    if {($tkPriv(popup) != "") || ($tkPriv(postedMb) != "")} {	tkMenuUnpost {}    }    tkPostOverPoint $menu $x $y $entry    if {$tcl_platform(platform) == "unix"} {	tkSaveGrabInfo $menu	grab -global $menu	set tkPriv(popup) $menu	tk_menuSetFocus($menu);    }}