# 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: