# 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.## SCCS: @(#) menu.tcl 1.97 97/08/13 10:58:34## Copyright (c) 1992-1994 The Regents of the University of California.# Copyright (c) 1994-1997 Sun Microsystems, Inc.## See the file "license.terms" for information on usage and redistribution# of this file, and for a DISCLAIMER OF ALL WARRANTIES.##-------------------------------------------------------------------------# Elements of tkPriv 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 tkPriv(oldGrab):  if#			tkPriv(oldGrab) is non-empty, then tkPriv(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.#-------------------------------------------------------------------------#-------------------------------------------------------------------------# Overall note:# This file is tricky because there are four different ways that menus# can be used:## 1. As a pulldown from a menubutton.  This is the most common usage.#    In this style, the variable tkPriv(postedMb) identifies the posted#    menubutton.# 2. As a torn-off menu copied from some other menu.  In this style#    tkPriv(postedMb) is empty, and the top-level menu is no#    override-redirect.# 3. As an option menu, triggered from an option menubutton.  In thi#    style tkPriv(postedMb) identifies the posted menubutton.# 4. As a popup menu.  In this style tkPriv(postedMb) is empty and#    the top-level menu is override-redirect.## 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> {    tkMbEnter %W}bind Menubutton <Leave> {    tkMbLeave %W}bind Menubutton <1> {    if {$tkPriv(inMenubutton) != ""} {	tkMbPost $tkPriv(inMenubutton) %X %Y    }}bind Menubutton <Motion> {    tkMbMotion %W up %X %Y}bind Menubutton <B1-Motion> {    tkMbMotion %W down %X %Y}bind Menubutton <ButtonRelease-1> {    tkMbButtonUp %W}bind Menubutton <space> {    tkMbPost %W    tkMenuFirstEntry [%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 tkPriv(window) %W    if {[%W cget -type] == "tearoff"} {	if {"%m" != "NotifyUngrab"} {	    if {$tcl_platform(platform) == "unix"} {		tk_menuSetFocus %W	    }	}    }    tkMenuMotion %W %x %y %s}bind Menu <Leave> {    tkMenuLeave %W %X %Y %s}bind Menu <Motion> {    tkMenuMotion %W %x %y %s}bind Menu <ButtonPress> {    tkMenuButtonDown %W}bind Menu <ButtonRelease> {   tkMenuInvoke %W 1}bind Menu <space> {    tkMenuInvoke %W 0}bind Menu <Return> {    tkMenuInvoke %W 0}bind Menu <Escape> {    tkMenuEscape %W}bind Menu <Left> {    tkMenuLeftArrow %W}bind Menu <Right> {    tkMenuRightArrow %W}bind Menu <Up> {    tkMenuUpArrow %W}bind Menu <Down> {    tkMenuDownArrow %W}bind Menu <KeyPress> {    tkTraverseWithinMenu %W %A}# The following bindings apply to all windows, and are used to# implement keyboard menu traversal.if {$tcl_platform(platform) == "unix"} {    bind all <Alt-KeyPress> {	tkTraverseToMenu %W %A    }    bind all <F10> {	tkFirstMenu %W    }} else {    bind Menubutton <Alt-KeyPress> {	tkTraverseToMenu %W %A    }    bind Menubutton <F10> {	tkFirstMenu %W    }}# tkMbEnter --# 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 tkMbB1Enter is invoked if the button is down.## Arguments:# w -			The  name of the widget.proc tkMbEnter w {    global tkPriv    if {$tkPriv(inMenubutton) != ""} {	tkMbLeave $tkPriv(inMenubutton)    }    set tkPriv(inMenubutton) $w    if {[$w cget -state] != "disabled"} {	$w configure -state active    }}# tkMbLeave --# 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 tkMbLeave w {    global tkPriv    set tkPriv(inMenubutton) {}    if ![winfo exists $w] {	return    }    if {[$w cget -state] == "active"} {	$w configure -state normal    }}# tkMbPost --# 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 tkMbPost {w {x {}} {y {}}} {    global tkPriv errorInfo    global tcl_platform    if {([$w cget -state] == "disabled") || ($w == $tkPriv(postedMb))} {	return    }    set menu [$w cget -menu]    if {$menu == ""} {	return    }    set tearoff [expr {($tcl_platform(platform) == "unix") \		     || ([$menu cget -type] == "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 $tkPriv(postedMb)    if {$cur != ""} {	tkMenuUnpost {}    }    set tkPriv(cursor) [$w cget -cursor]    set tkPriv(relief) [$w cget -relief]    $w configure -cursor arrow    $w configure -relief raised    set tkPriv(postedMb) $w    set tkPriv(focus) [focus]    $menu activate none    event generate $menu <<MenuSelect>>    # 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]]    	    	$menu post $x $y    	    }    	    below {    	    	set x [winfo rootx $w]    	    	set y [expr [winfo rooty $w] + [winfo height $w]]    	    	$menu post $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 [tkMenuFindName $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]		    }    	    	}    	    	$menu post $x $y    	    	if {($entry != {}) && ([$menu entrycget $entry -state] != "disabled")} {    	    	    $menu activate $entry		    event generate $menu <<MenuSelect>>    	    	}    	    }    	    right {    	    	set x [expr [winfo rootx $w] + [winfo width $w]]    	    	set y [expr (2 * [winfo rooty $w] + [winfo height $w]) / 2]    	    	set entry [tkMenuFindName $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]		    }    	    	}    	    	$menu post $x $y    	    	if {($entry != {}) && ([$menu entrycget $entry -state] != "disabled")} {    	    	    $menu activate $entry		    event generate $menu <<MenuSelect>>    	    	}    	    }    	    default {    	    	if [$w cget -indicatoron] {	    	    if {$y == ""} {			set x [expr [winfo rootx $w] + [winfo width $w]/2]			set y [expr [winfo rooty $w] + [winfo height $w]/2]	    	    }	            tkPostOverPoint $menu $x $y [tkMenuFindName $menu [$w cget -text]]		} else {	    	    $menu post [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	tkMenuUnpost {}	error $msg $savedInfo    }    set tkPriv(tearoff) $tearoff    if {$tearoff != 0} {    	focus $menu    	tkSaveGrabInfo $w    	grab -global $w    }}# tkMenuUnpost --# 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 tkMenuUnpost menu {    global tcl_platform    global tkPriv    set mb $tkPriv(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 $tkPriv(focus)}    set tkPriv(focus) ""    # Unpost menu(s) and restore some stuff that's dependent on    # what was posted.    catch {	if {$mb != ""} {	    set menu [$mb cget -menu]	    $menu unpost	    set tkPriv(postedMb) {}	    $mb configure -cursor $tkPriv(cursor)	    $mb configure -relief $tkPriv(relief)	} elseif {$tkPriv(popup) != ""} {	    $tkPriv(popup) unpost	    set tkPriv(popup) {}	} elseif {(!([$menu cget -type] == "menubar")		&& !([$menu cget -type] == "tearoff"))		|| [wm overrideredirect $menu]} {	    # 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