head	1.34;
access;
symbols
	core-8-5-9:1.26.2.6
	core-8-5-8:1.26.2.5
	macosx-cocoa-merge:1.32
	macosx-cocoa-premerge:1.32
	macosx-carbon-freeze:1.32
	core-8-5-7:1.26.2.5
	core-8-5-6:1.26.2.4
	core-8-6-b1:1.31
	core-8-6-a3:1.31
	core-8-5-5:1.26.2.4
	core-8-6-a2:1.26
	core-8-5-4:1.26
	core-8-5-3:1.26
	core-8-6-a1:1.26
	core-8-4-19:1.18.2.5
	core-8-5-branch:1.26.0.2
	core-8-5-2:1.26
	core-8-4-18:1.18.2.5
	core-8-5-1:1.26
	core-8-4-17:1.18.2.5
	core-8-5-0:1.26
	core-8-5-b3:1.25
	core-8-5-b2:1.23
	core-8-4-16:1.18.2.4
	core-8-5-b1:1.23
	core-stablilizer-merge:1.23
	core-stabilizer-branch:1.23.0.2
	core-stabilizer-merge:1.26
	core-8-4-15:1.18.2.4
	core-8-5-a6:1.23
	core-8-5-a5:1.23
	core-8-4-14:1.18.2.4
	core-8-5-a4:1.23
	core-8-4-13:1.18.2.4
	core-8-4-12:1.18.2.3
	core-8-4-11:1.18.2.2
	core-8-5-a3:1.21
	core-8-4-10:1.18.2.2
	core-8-4-9-branch:1.18.2.1.0.2
	core-8-5-a2:1.20
	core-8-4-9:1.18.2.1
	core-8-4-8:1.18.2.1
	core-8-4-7:1.18.2.1
	core-8-5-a1:1.20
	core-8-4-6:1.18.2.1
	core-8-4-5:1.18
	mistachkin-dev-branch:1.19.0.2
	core-8-4-4:1.18
	core-8-4-3:1.18
	core-8-4-branch:1.18.0.2
	core-8-4-2:1.18
	core-8-4-1:1.18
	core-8-3-5:1.12
	core-8-4-0:1.18
	macosx-8-4-merge-2002-08-31-trunk:1.18
	macosx-8-4-premerge-2002-08-31-branch:1.13.2.4
	macosx-8-4-premerge-2002-08-31-trunk:1.17
	macosx-8-4-merge-2002-08-30-branch:1.13.2.3
	macosx-8-4-merge-2002-08-30-trunk:1.17
	macosx-8-4-merge-2002-08-20-branch:1.13.2.3
	macosx-8-4-merge-2002-08-20-trunk:1.17
	core-8-4-b2:1.17
	core-8-4-b1:1.17
	macosx-premerge-6-9-02:1.13.2.2
	core-8-4-a4:1.15
	core-8-3-4:1.12
	macosx-8-4-branch:1.13.0.2
	macosx-8-4-branchpoint:1.13
	core-8-4-a3:1.13
	core-8-3-3:1.12
	dgp-privates-into-namespace:1.12.0.6
	tclpro-1-5-0:1.12
	core-8-4-win-speedup:1.12.0.4
	core-8-4-a2:1.12
	tclpro-1-4-1:1.12
	tclpro-1-4-0:1.12
	core-8-3-2:1.12
	ajuba-ajuba2-2-1-base:1.12
	ajuba-ajuba2-2-0:1.12
	core-8-4-a1:1.12
	core-8-3-1-branch:1.12.0.2
	core-8-3-1:1.12
	scriptics-sc-2-0-b5:1.10
	scriptics-sc-2-0-fixed:1.10
	scriptics-sc-2-0-b2:1.10
	scriptics-sc-2-0-b1:1.10
	core-8-3-0:1.8
	core-8-3-b2:1.8
	core-8-3-b1:1.8
	scriptics-sc-1-1:1.7
	scriptics-sc-1-1-b1:1.7
	core-8-2-3:1.7
	scriptics-sc-1-1-branch:1.7.0.8
	scriptics-sc-1-1-base:1.7
	scriptics-sc-1-0:1.7
	scriptics-sc-1-0-branch:1.7.0.6
	scriptics-sc-1-0-base:1.7
	core-8-2-2:1.7
	core-8-2-1:1.7
	scriptics-bc-1-0-b1:1.7
	core-8-2-1-branch:1.7.0.4
	scriptics-tclpro-1-3-0:1.7
	core-8-2-0:1.7
	core-8-2-b3-branch:1.7.0.2
	core-8-2-b3-base:1.7
	scriptics-tclpro-1-3-b4:1.7
	core-8-2-b2:1.7
	scriptics-tclpro-1-3-b3:1.6
	core-8-2-b1:1.6
	scriptics-tclpro-1-3-b2:1.6
	merge-to-mainline-5/21/99:1.6
	scriptics-tclpro-1-3-b2-branch:1.6.0.2
	core-8-1-1:1.6
	scriptics-tclpro-1-3-b1:1.6
	core-8-1-1-base:1.6
	core-8-1-0:1.5
	merge-to-mainline-4-29-99:1.5
	merge-to-mainline-4-23-99:1.5
	core-8-1-branch-old:1.1.0.4
	core-8-0-6-branch:1.4.0.6
	core-8-0-6-base:1.4
	core-8-0-5:1.4
	core-8-1-b3:1.1.4.6
	core-8-1-b2:1.1.4.3
	dev-8-1-stubs-branch:1.1.4.3.0.2
	dev-stubs-branch:1.4.0.4
	scriptics-tclpro-1-2:1.4
	scriptics-tclpro-1-2-b2:1.4
	core-8-1-merge-2/10/99:1.4
	core-8-0-5-branch:1.4.0.2
	core-8-0-5-base:1.4
	scriptics-tclpro-1-2-b1:1.3
	scriptics-tclpro-1-2-a1:1.3
	core-8-1-b1:1.1.4.2
	core-8-0-4:1.3
	core-8-1-a2:1.1.4.1
	core-8-0-2:1.1
	core-8-0-3:1.3;
locks; strict;
comment	@# @;


1.34
date	2010.03.06.01.11.07;	author patthoyts;	state Exp;
branches;
next	1.33;

1.33
date	2010.01.09.00.43.46;	author patthoyts;	state Exp;
branches;
next	1.32;

1.32
date	2009.04.10.16.08.42;	author das;	state Exp;
branches;
next	1.31;

1.31
date	2008.09.09.18.17.54;	author tmh;	state Exp;
branches;
next	1.30;

1.30
date	2008.09.09.17.48.58;	author tmh;	state Exp;
branches;
next	1.29;

1.29
date	2008.08.27.18.49.46;	author tmh;	state Exp;
branches;
next	1.28;

1.28
date	2008.08.25.23.05.40;	author tmh;	state Exp;
branches;
next	1.27;

1.27
date	2008.08.25.23.01.15;	author tmh;	state Exp;
branches;
next	1.26;

1.26
date	2007.12.13.15.26.27;	author dgp;	state Exp;
branches
	1.26.2.1;
next	1.25;

1.25
date	2007.11.09.06.23.28;	author das;	state Exp;
branches;
next	1.24;

1.24
date	2007.11.08.14.25.37;	author das;	state Exp;
branches;
next	1.23;

1.23
date	2005.10.16.02.36.45;	author hobbs;	state Exp;
branches
	1.23.2.1;
next	1.22;

1.22
date	2005.07.25.09.06.00;	author dkf;	state Exp;
branches;
next	1.21;

1.21
date	2005.05.27.18.06.26;	author tmh;	state Exp;
branches;
next	1.20;

1.20
date	2004.02.04.00.25.13;	author hobbs;	state Exp;
branches;
next	1.19;

1.19
date	2003.06.26.17.15.48;	author vincentdarley;	state Exp;
branches;
next	1.18;

1.18
date	2002.08.31.06.12.28;	author das;	state Exp;
branches
	1.18.2.1;
next	1.17;

1.17
date	2002.06.22.09.08.40;	author hobbs;	state Exp;
branches;
next	1.16;

1.16
date	2002.06.11.18.59.25;	author jenglish;	state Exp;
branches;
next	1.15;

1.15
date	2001.11.27.14.08.04;	author drh;	state Exp;
branches;
next	1.14;

1.14
date	2001.11.16.22.54.22;	author hobbs;	state Exp;
branches;
next	1.13;

1.13
date	2001.08.01.16.21.11;	author dgp;	state Exp;
branches
	1.13.2.1;
next	1.12;

1.12
date	2000.04.17.19.32.00;	author ericm;	state Exp;
branches
	1.12.4.1
	1.12.6.1;
next	1.11;

1.11
date	2000.03.31.09.24.11;	author hobbs;	state Exp;
branches;
next	1.10;

1.10
date	2000.03.10.22.16.36;	author ericm;	state Exp;
branches;
next	1.9;

1.9
date	2000.03.07.01.02.26;	author ericm;	state Exp;
branches;
next	1.8;

1.8
date	99.09.02.17.02.52;	author hobbs;	state Exp;
branches;
next	1.7;

1.7
date	99.07.22.16.31.48;	author redman;	state Exp;
branches;
next	1.6;

1.6
date	99.05.07.20.05.40;	author stanton;	state Exp;
branches;
next	1.5;

1.5
date	99.04.16.01.51.26;	author stanton;	state Exp;
branches;
next	1.4;

1.4
date	99.02.04.20.58.40;	author stanton;	state Exp;
branches;
next	1.3;

1.3
date	98.09.14.18.23.23;	author stanton;	state Exp;
branches;
next	1.2;

1.2
date	98.06.27.18.06.40;	author welch;	state Exp;
branches;
next	1.1;

1.1
date	98.04.01.09.55.09;	author rjohnson;	state Exp;
branches
	1.1.4.1;
next	;

1.1.4.1
date	98.09.29.00.25.30;	author stanton;	state Exp;
branches;
next	1.1.4.2;

1.1.4.2
date	98.09.30.02.17.33;	author stanton;	state Exp;
branches;
next	1.1.4.3;

1.1.4.3
date	99.02.11.04.13.48;	author stanton;	state Exp;
branches;
next	1.1.4.4;

1.1.4.4
date	99.03.26.19.37.12;	author surles;	state Exp;
branches;
next	1.1.4.5;

1.1.4.5
date	99.03.26.20.01.25;	author surles;	state Exp;
branches;
next	1.1.4.6;

1.1.4.6
date	99.04.06.03.52.55;	author stanton;	state Exp;
branches;
next	;

1.12.4.1
date	2002.04.06.01.02.01;	author hobbs;	state Exp;
branches;
next	;

1.12.6.1
date	2001.02.28.23.29.56;	author dgp;	state Exp;
branches;
next	;

1.13.2.1
date	2001.10.15.09.22.00;	author wolfsuit;	state Exp;
branches;
next	1.13.2.2;

1.13.2.2
date	2002.02.05.02.25.16;	author wolfsuit;	state Exp;
branches;
next	1.13.2.3;

1.13.2.3
date	2002.08.20.20.27.09;	author das;	state Exp;
branches;
next	1.13.2.4;

1.13.2.4
date	2002.08.30.18.18.14;	author das;	state Exp;
branches;
next	;

1.18.2.1
date	2004.02.04.00.23.04;	author hobbs;	state Exp;
branches;
next	1.18.2.2;

1.18.2.2
date	2005.05.27.18.00.59;	author tmh;	state Exp;
branches;
next	1.18.2.3;

1.18.2.3
date	2005.12.01.17.47.14;	author hobbs;	state Exp;
branches;
next	1.18.2.4;

1.18.2.4
date	2006.01.25.18.21.41;	author dgp;	state Exp;
branches;
next	1.18.2.5;

1.18.2.5
date	2007.11.09.06.26.54;	author das;	state Exp;
branches;
next	;

1.23.2.1
date	2007.11.12.19.22.38;	author dgp;	state Exp;
branches;
next	;

1.26.2.1
date	2008.08.25.23.37.12;	author tmh;	state Exp;
branches;
next	1.26.2.2;

1.26.2.2
date	2008.08.27.18.51.07;	author tmh;	state Exp;
branches;
next	1.26.2.3;

1.26.2.3
date	2008.09.09.17.47.21;	author tmh;	state Exp;
branches;
next	1.26.2.4;

1.26.2.4
date	2008.09.09.18.17.08;	author tmh;	state Exp;
branches;
next	1.26.2.5;

1.26.2.5
date	2009.04.10.16.08.45;	author das;	state Exp;
branches;
next	1.26.2.6;

1.26.2.6
date	2010.01.09.00.51.38;	author patthoyts;	state Exp;
branches;
next	;


desc
@@


1.34
log
@[Bug 2949774]: cascade menus should popdown ofter loosing the pointer.

When the pointer moves to another entry from a cascade entry the sub-menu
should popdown. This is how other menus on X11 work today. This effect will
not be used if the user has configured ClickToFocus to maintain the previous
Tk menu effects.
@
text
@# 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.33 2010/01/09 00:43:46 patthoyts 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.
# Copyright (c) 2007 Daniel A. Steffen <das@@users.sourceforge.net>
#
# 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 {[tk windowingsystem] eq "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 {$Priv(inMenubutton) ne ""} {
	MbLeave $Priv(inMenubutton)
    }
    set Priv(inMenubutton) $w
    if {[$w cget -state] ne "disabled" && [tk windowingsystem] ne "aqua"} {
	$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 {[$w cget -state] eq "active" && [tk windowingsystem] ne "aqua"} {
	$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 {$menu eq ""} {
	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 {$cur ne ""} {
	MenuUnpost {}
    }
    if {$::tk_strictMotif} {
        set Priv(cursor) [$w cget -cursor]
        $w configure -cursor arrow
    }
    if {[tk windowingsystem] ne "aqua"} {
	set Priv(relief) [$w cget -relief]
	$w configure -relief raised
    } else {
	$w configure -state active
    }

    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] && $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}]
		    }
    	    	}
		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] && $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}]
		    }
    	    	}
		PostOverPoint $menu $x $y
		if {$entry ne "" \
			&& [$menu entrycget $entry -state] ne "disabled"} {
    	    	    $menu activate $entry
		    GenerateMenuSelect $menu
    	    	}
    	    }
    	    default {
    	    	if {[$w cget -indicatoron]} {
		    if {$y eq ""} {
			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.

    after cancel [array get Priv menuActivatedTimer]
    unset -nocomplain Priv(menuActivated)
    after cancel [array get Priv menuDeactivatedTimer]
    unset -nocomplain Priv(menuDeactivated)

    catch {
	if {$mb ne ""} {
	    set menu [$mb cget -menu]
	    $menu unpost
	    set Priv(postedMb) {}
	    if {$::tk_strictMotif} {
	        $mb configure -cursor $Priv(cursor)
	    }
	    if {[tk windowingsystem] ne "aqua"} {
		$mb configure -relief $Priv(relief)
	    } else {
		$mb configure -state normal
	    }
	} elseif {$Priv(popup) ne ""} {
	    $Priv(popup) unpost
	    set Priv(popup) {}
	} elseif {[$menu cget -type] ne "menubar" \
		&& [$menu cget -type] ne "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 {[winfo class $parent] ne "Menu" \
			|| ![winfo ismapped $parent]} {
		    break
		}
		$parent activate none
		$parent postcascade none
		GenerateMenuSelect $parent
		set type [$parent cget -type]
		if {$type eq "menubar" || $type eq "tearoff"} {
		    break
		}
		set menu $parent
	    }
	    if {[$menu cget -type] ne "menubar"} {
		$menu unpost
	    }
	}
    }

    if {($Priv(tearoff) != 0) || $Priv(menuBar) ne ""} {
    	# Release grab, if any, and restore the previous grab, if there
    	# was one.
	if {$menu ne ""} {
	    set grab [grab current $menu]
	    if {$grab ne ""} {
		grab release $grab
	    }
	}
	RestoreOldGrab
	if {$Priv(menuBar) ne ""} {
	    if {$::tk_strictMotif} {
		$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 {$Priv(inMenubutton) eq $w} {
	return
    }
    set new [winfo containing $rootx $rooty]
    if {$new ne $Priv(inMenubutton) \
	    && ($new eq "" || [winfo toplevel $new] eq [winfo toplevel $w])} {
	if {$Priv(inMenubutton) ne ""} {
	    MbLeave $Priv(inMenubutton)
	}
	if {$new ne "" \
		&& [winfo class $new] eq "Menubutton" \
		&& ([$new cget -indicatoron] == 0) \
		&& ([$w cget -indicatoron] == 0)} {
	    if {$upDown eq "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 {$menu eq $Priv(window)} {
        set activeindex [$menu index active]
	if {[$menu cget -type] eq "menubar"} {
	    if {[info exists Priv(focus)] && $menu ne $Priv(focus)} {
		$menu activate @@$x,$y
		GenerateMenuSelect $menu
	    }
	} else {
	    $menu activate @@$x,$y
	    GenerateMenuSelect $menu
	}
        set index [$menu index @@$x,$y]
        if {[info exists Priv(menuActivated)] \
                && $index ne "none" \
                && $index ne $activeindex} {
            set mode [option get $menu clickToFocus ClickToFocus]
            if {$mode eq "" || ([string is boolean $mode] && !$mode)} {
                set delay [expr {[$menu cget -type] eq "menubar" ? 0 : 50}]
                if {[$menu type $activeindex] eq "cascade"} {
                    set Priv(menuDeactivatedTimer) \
                        [after $delay [list $menu postcascade none]]
                }
                if {[$menu type $index] eq "cascade"} {
                    set Priv(menuActivatedTimer) \
                        [after $delay [list $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 {$Priv(postedMb) ne "" && [winfo viewable $Priv(postedMb)]} {
	grab -global $Priv(postedMb)
    } else {
	while {[$menu cget -type] eq "normal" \
		&& [winfo class [winfo parent $menu]] eq "Menu" \
		&& [winfo ismapped [winfo parent $menu]]} {
	    set menu [winfo parent $menu]
	}

	if {$Priv(menuBar) eq {}} {
	    set Priv(menuBar) $menu
	    if {$::tk_strictMotif} {
		set Priv(cursor) [$menu cget -cursor]
		$menu configure -cursor arrow
	    }
	    if {[$menu type active] eq "cascade"} {
		set Priv(menuActivated) 1
	    }
        }

	# 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 ne [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 {[tk windowingsystem] eq "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 {[$menu index active] eq "none"} {
	return
    }
    if {[$menu type active] eq "cascade" \
	    && [winfo containing $rootx $rooty] eq \
		[$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 && $Priv(window) eq ""} {
	# 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 {[$w type active] eq "cascade"} {
	$w postcascade active
	set menu [$w entrycget active -menu]
	MenuFirstEntry $menu
    } elseif {[$w type active] eq "tearoff"} {
	::tk::TearOffMenu $w
	MenuUnpost $w
    } elseif {[$w cget -type] eq "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 {[winfo class $parent] ne "Menu"} {
	MenuUnpost $menu
    } elseif {[$parent cget -type] eq "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 {[$menu cget -type] eq "menubar"} {
	MenuNextMenu $menu left
    } else {
	MenuNextEntry $menu -1
    }
}

proc ::tk::MenuDownArrow {menu} {
    if {[$menu cget -type] eq "menubar"} {
	MenuNextMenu $menu right
    } else {
	MenuNextEntry $menu 1
    }
}

proc ::tk::MenuLeftArrow {menu} {
    if {[$menu cget -type] eq "menubar"} {
	MenuNextEntry $menu -1
    } else {
	MenuNextMenu $menu left
    }
}

proc ::tk::MenuRightArrow {menu} {
    if {[$menu cget -type] eq "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 {$direction eq "right"} {
	set count 1
	set parent [winfo parent $menu]
	set class [winfo class $parent]
	if {[$menu type active] eq "cascade"} {
	    $menu postcascade active
	    set m2 [$menu entrycget active -menu]
	    if {$m2 ne ""} {
		MenuFirstEntry $m2
	    }
	    return
	} else {
	    set parent [winfo parent $menu]
	    while {$parent ne "."} {
		if {[winfo class $parent] eq "Menu" \
			&& [$parent cget -type] eq "menubar"} {
		    tk_menuSetFocus $parent
		    MenuNextEntry $parent 1
		    return
		}
		set parent [winfo parent $parent]
	    }
	}
    } else {
	set count -1
	set m2 [winfo parent $menu]
	if {[winfo class $m2] eq "Menu"} {
	    $menu activate none
	    GenerateMenuSelect $menu
	    tk_menuSetFocus $m2

	    $m2 postcascade none

	    if {[$m2 cget -type] ne "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 {[winfo class $m2] eq "Menu" && [$m2 cget -type] eq "menubar"} {
	tk_menuSetFocus $m2
	MenuNextEntry $m2 -1
	return
    }

    set w $Priv(postedMb)
    if {$w eq ""} {
	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] eq "Menubutton" \
		&& [$mb cget -state] ne "disabled" \
		&& [$mb cget -menu] ne "" \
		&& [[$mb cget -menu] index last] ne "none"} {
	    break
	}
	if {$mb eq $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 {[$menu index last] eq "none"} {
	return
    }
    set length [expr {[$menu index last]+1}]
    set quitAfter $length
    set active [$menu index active]
    if {$active eq "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 {[$menu type $i] eq "cascade" && [$menu cget -type] eq "menubar"} {
	set cascade [$menu entrycget $i -menu]
	if {$cascade ne ""} {
	    # 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 {[winfo toplevel $w] ne [winfo toplevel $child]} {
	    continue
	}
	if {[winfo class $child] eq "Menu" && \
		[$child cget -type] eq "menubar"} {
	    if {$char eq ""} {
		return $child
	    }
	    set last [$child index last]
	    for {set i [$child cget -tearoff]} {$i <= $last} {incr i} {
		if {[$child type $i] eq "separator"} {
		    continue
		}
		set char2 [string index [$child entrycget $i -label] \
			[$child entrycget $i -underline]]
		if {$char eq [string tolower $char2] || $char eq ""} {
		    if {[$child entrycget $i -state] ne "disabled"} {
			return $child
		    }
		}
	    }
	}
    }

    foreach child $windowlist {
	# Don't descend into other toplevels.
        if {[winfo toplevel $w] ne [winfo toplevel $child]} {
	    continue
	}
	switch -- [winfo class $child] {
	    Menubutton {
		set char2 [string index [$child cget -text] \
			[$child cget -underline]]
		if {$char eq [string tolower $char2] || $char eq ""} {
		    if {[$child cget -state] ne "disabled"} {
			return $child
		    }
		}
	    }

	    default {
		set match [MenuFind $child $char]
		if {$match ne ""} {
		    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 {$char eq ""} {
	return
    }
    while {[winfo class $w] eq "Menu"} {
	if {[$w cget -type] ne "menubar" && $Priv(postedMb) eq ""} {
	    return
	}
	if {[$w cget -type] eq "menubar"} {
	    break
	}
	set w [winfo parent $w]
    }
    set w [MenuFind [winfo toplevel $w] $char]
    if {$w ne ""} {
	if {[winfo class $w] eq "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 {$w ne ""} {
	if {[winfo class $w] eq "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 {$char eq ""} {
	return
    }
    set char [string tolower $char]
    set last [$w index last]
    if {$last eq "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 {$char eq [string tolower $char2]} {
	    if {[$w type $i] eq "cascade"} {
		$w activate $i
		$w postcascade active
		event generate $w <<MenuSelect>>
		set m2 [$w entrycget $i -menu]
		if {$m2 ne ""} {
		    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 {$menu eq ""} {
	return
    }
    tk_menuSetFocus $menu
    if {[$menu index active] ne "none"} {
	return
    }
    set last [$menu index last]
    if {$last eq "none"} {
	return
    }
    for {set i 0} {$i <= $last} {incr i} {
	if {([catch {set state [$menu entrycget $i -state]}] == 0) \
		&& $state ne "disabled" && [$menu type $i] ne "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 {[$menu type $i] eq "cascade" \
		    && [$menu cget -type] eq "menubar"} {
		set cascade [$menu entrycget $i -menu]
		if {$cascade ne ""} {
		    $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 {$last eq "none"} {
	return
    }
    for {set i 0} {$i <= $last} {incr i} {
	if {![catch {$menu entrycget $i -label} label]} {
	    if {$label eq $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) == "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 {$Priv(grabStatus) eq "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)] || $Priv(focus) eq ""} {
	set Priv(focus) [focus]
    }
    focus $menu
}
    
proc ::tk::GenerateMenuSelect {menu} {
    variable ::tk::Priv

    if {$Priv(activeMenu) eq $menu \
	    && $Priv(activeItem) eq [$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
	set Priv(menuActivated) 1
	tk_menuSetFocus $menu
    }
}
@


1.33
log
@TIP 360: Make Tk menu activation follow mouse movement.

This patch makes Tk menus on unix follow mouse motion in the same
way Windows and GNOME menus follow the mouse. Once a menubar dropdown
has been activated, moving the mouse to another menubar button or
cascade item will activate the dropdown without needing another click.

The previous behaviour can be restored by setting the *Menu.clickToFocus
option true or by calling 'tk::classic::restore menu' if this is preferred.

Signed-off-by: Pat Thoyts <patthoyts@@users.sourceforge.net>
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: menu.tcl,v 1.32 2009/04/10 16:08:42 das Exp $
d411 2
d568 1
a568 2
                && $index ne $activeindex \
                && [$menu type $index] eq "cascade"} {
d571 9
a579 3
                set delay [expr {[$menu cget -type] eq "menubar"? 0 : 50}]
                set Priv(menuActivatedTimer) \
                    [after $delay [list $menu postcascade active]]
@


1.32
log
@	* library/menu.tcl (::tk::MbPost): fix error thrown in y position
	computation with indicatoron.
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: menu.tcl,v 1.31 2008/09/09 18:17:54 tmh Exp $
d409 3
d553 1
d563 12
a574 3
    }
    if {($state & 0x1f00) != 0} {
	$menu postcascade active
d616 3
d1330 1
@


1.31
log
@a final fix
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: menu.tcl,v 1.30 2008/09/09 17:48:58 tmh Exp $
d310 1
a310 1
    	    	if {[$w cget -indicatoron]} {
d330 1
a330 1
    	    	if {[$w cget -indicatoron]} {
@


1.30
log
@add global tk_strickMotif
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: menu.tcl,v 1.29 2008/08/27 18:49:46 tmh Exp $
d246 1
a246 1
    global tcl_platform tk_strictMotif
d395 1
a395 1
    global tcl_platform tk_strictMotif
d582 1
a582 1
    global tcl_platform tk_strictMotif
@


1.29
log
@fix typo in menu.tcl
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: menu.tcl,v 1.28 2008/08/25 23:05:40 tmh Exp $
d246 1
a246 1
    global tcl_platform
d395 1
a395 1
    global tcl_platform
d582 1
a582 1
    global tcl_platform
@


1.28
log
@correct to use global namespace varialbe : 1023955
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: menu.tcl,v 1.27 2008/08/25 23:01:15 tmh Exp $
d264 1
a264 1
    if {$::tk_stricktMotif} {
@


1.27
log
@[Bug 1023955] don't flip to arrow cursor on menus
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: menu.tcl,v 1.26 2007/12/13 15:26:27 dgp Exp $
d264 1
a264 1
    if {$tk_stricktMotif} {
d414 1
a414 1
	    if {$tk_strictMotif} {
d464 1
a464 1
	    if {$tk_strictMotif} {
d599 1
a599 1
	    if {$tk_strictMotif} {
@


1.26
log
@merge stable branch onto HEAD
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: menu.tcl,v 1.23.2.1 2007/11/12 19:22:38 dgp Exp $
d264 4
a267 2
    set Priv(cursor) [$w cget -cursor]
    $w configure -cursor arrow
d414 3
a416 1
	    $mb configure -cursor $Priv(cursor)
d464 3
a466 1
	    $Priv(menuBar) configure -cursor $Priv(cursor)
d599 4
a602 2
	    set Priv(cursor) [$menu cget -cursor]
	    $menu configure -cursor arrow
@


1.26.2.1
log
@[bug 1023955 : don't flip cursors on menus to arrow pointer.
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: menu.tcl,v 1.26 2007/12/13 15:26:27 dgp Exp $
d264 2
a265 4
    if {$tk_stricktMotif} {
        set Priv(cursor) [$w cget -cursor]
        $w configure -cursor arrow
    }
d412 1
a412 3
	    if {$tk_strictMotif} {
	        $mb configure -cursor $Priv(cursor)
	    }
d460 1
a460 3
	    if {$tk_strictMotif} {
		$Priv(menuBar) configure -cursor $Priv(cursor)
	    }
d593 2
a594 4
	    if {$tk_strictMotif} {
		set Priv(cursor) [$menu cget -cursor]
		$menu configure -cursor arrow
	    }
@


1.26.2.2
log
@fix typo added to menu.tcl
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: menu.tcl,v 1.26.2.1 2008/08/25 23:37:12 tmh Exp $
d264 1
a264 1
    if {$tk_strictMotif} {
@


1.26.2.3
log
@add global commands for tk_strictMotif variable
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: menu.tcl,v 1.26.2.2 2008/08/27 18:51:07 tmh Exp $
d246 1
a246 1
    global tcl_platform tk_strictMotif
d395 1
a395 1
    global tcl_platform tk_strictMotif
d582 1
a582 1
    global tcl_platform tk_strictMotif
@


1.26.2.4
log
@a final fix
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: menu.tcl,v 1.26.2.3 2008/09/09 17:47:21 tmh Exp $
d246 1
a246 1
    global tcl_platform
d264 1
a264 1
    if {$::tk_strictMotif} {
d395 1
a395 1
    global tcl_platform
d414 1
a414 1
	    if {$::tk_strictMotif} {
d464 1
a464 1
	    if {$::tk_strictMotif} {
d582 1
a582 1
    global tcl_platform
d599 1
a599 1
	    if {$::tk_strictMotif} {
@


1.26.2.5
log
@	* library/menu.tcl (::tk::MbPost): fix error thrown in y position
	computation with indicatoron.
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: menu.tcl,v 1.26.2.4 2008/09/09 18:17:08 tmh Exp $
d310 1
a310 1
		if {[$w cget -indicatoron] && $entry ne ""} {
d330 1
a330 1
		if {[$w cget -indicatoron] && $entry ne ""} {
@


1.26.2.6
log
@TIP 360: Make Tk menu activation follow mouse movements.
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: menu.tcl,v 1.26.2.5 2009/04/10 16:08:45 das Exp $
a408 3
    after cancel [array get Priv menuActivatedTimer]
    unset -nocomplain Priv(menuActivated)

a549 1
        set activeindex [$menu index active]
d559 3
a561 12
        set index [$menu index @@$x,$y]
        if {[info exists Priv(menuActivated)] \
                && $index ne "none" \
                && $index ne $activeindex \
                && [$menu type $index] eq "cascade"} {
            set mode [option get $menu clickToFocus ClickToFocus]
            if {$mode eq "" || ([string is boolean $mode] && !$mode)} {
                set delay [expr {[$menu cget -type] eq "menubar"? 0 : 50}]
                set Priv(menuActivatedTimer) \
                    [after $delay [list $menu postcascade active]]
            }
        }
a602 3
	    if {[$menu type active] eq "cascade"} {
		set Priv(menuActivated) 1
	    }
a1313 1
	set Priv(menuActivated) 1
@


1.25
log
@	* macosx/tkMacOSXButton.c:	sync formatting, whitespace, copyright
	* macosx/tkMacOSXDialog.c:	with core-8-4-branch.
	* macosx/tkMacOSXMenus.c:
	* macosx/tkMacOSXWm.c:
	* xlib/xgc.c
	* library/bgerror.tcl:
	* library/console.tcl:
	* library/menu.tcl:
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: menu.tcl,v 1.24 2007/11/08 14:25:37 das Exp $
@


1.24
log
@	* library/menu.tcl:		correct handling of menubutton "active"
					state on Aqua to match that of buttons.
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: menu.tcl,v 1.23 2005/10/16 02:36:45 hobbs Exp $
d12 1
@


1.23
log
@	* library/menu.tcl (::tk::MenuUnpost): remove leftover ] from
	string equal mods of 2005-07-25. (sowadsky)
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: menu.tcl,v 1.22 2005/07/25 09:06:00 dkf Exp $
d206 1
a206 1
    if {[$w cget -state] ne "disabled"} {
d225 1
a225 1
    if {[$w cget -state] eq "active"} {
a263 1
    set Priv(relief) [$w cget -relief]
d265 6
a270 1
    $w configure -relief raised
d412 5
a416 1
	    $mb configure -relief $Priv(relief)
@


1.23.2.1
log
@merge updates from HEAD
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: menu.tcl,v 1.23 2005/10/16 02:36:45 hobbs Exp $
a11 1
# Copyright (c) 2007 Daniel A. Steffen <das@@users.sourceforge.net>
d206 1
a206 1
    if {[$w cget -state] ne "disabled" && [tk windowingsystem] ne "aqua"} {
d225 1
a225 1
    if {[$w cget -state] eq "active" && [tk windowingsystem] ne "aqua"} {
d264 1
d266 1
a266 6
    if {[tk windowingsystem] ne "aqua"} {
	set Priv(relief) [$w cget -relief]
	$w configure -relief raised
    } else {
	$w configure -state active
    }
d408 1
a408 5
	    if {[tk windowingsystem] ne "aqua"} {
		$mb configure -relief $Priv(relief)
	    } else {
		$mb configure -state normal
	    }
@


1.22
log
@Apply some of the changes suggested in [Patch 1237759]
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: menu.tcl,v 1.21 2005/05/27 18:06:26 tmh Exp $
d429 1
a429 1
		if {$type eq "menubar" || $type eq "tearoff"]} {
@


1.21
log
@change tk_popup to have sticky menus
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: menu.tcl,v 1.20 2004/02/04 00:25:13 hobbs Exp $
d172 1
a172 1
if {[string equal [tk windowingsystem] "x11"]} {
d202 1
a202 1
    if {[string compare $Priv(inMenubutton) ""]} {
d206 1
a206 1
    if {[string compare [$w cget -state] "disabled"]} {
d225 1
a225 1
    if {[string equal [$w cget -state] "active"]} {
d251 1
a251 1
    if {[string equal $menu ""]} {
d260 1
a260 1
    if {[string compare $cur ""]} {
d341 1
a341 1
		    if {[string equal $y {}]} {
d403 1
a403 1
	if {[string compare $mb ""]} {
d409 1
a409 1
	} elseif {[string compare $Priv(popup) ""]} {
d412 2
a413 2
	} elseif {[string compare [$menu cget -type] "menubar"] \
		&& [string compare [$menu cget -type] "tearoff"]} {
d421 1
a421 1
		if {[string compare [winfo class $parent] "Menu"] \
d429 1
a429 2
		if {[string equal $type "menubar"] || \
			[string equal $type "tearoff"]} {
d434 1
a434 1
	    if {[string compare [$menu cget -type] "menubar"]} {
d443 1
a443 1
	if {[string compare $menu ""]} {
d445 1
a445 1
	    if {[string compare $grab ""]} {
d474 1
a474 1
    if {[string equal $Priv(inMenubutton) $w]} {
d478 3
a480 4
    if {[string compare $new $Priv(inMenubutton)] \
	    && ([string equal $new ""] \
	    || [string equal [winfo toplevel $new] [winfo toplevel $w]])} {
	if {[string compare $Priv(inMenubutton) ""]} {
d483 2
a484 2
	if {[string compare $new ""] \
		&& [string equal [winfo class $new] "Menubutton"] \
d487 1
a487 1
	    if {[string equal $upDown "down"]} {
d534 3
a536 4
    if {[string equal $menu $Priv(window)]} {
	if {[string equal [$menu cget -type] "menubar"]} {
	    if {[info exists Priv(focus)] && \
		    [string compare $menu $Priv(focus)]} {
d573 1
a573 2
    if {[string compare $Priv(postedMb) ""] && \
	    [winfo viewable $Priv(postedMb)]} {
d576 2
a577 2
	while {[string equal [$menu cget -type] "normal"] \
		&& [string equal [winfo class [winfo parent $menu]] "Menu"] \
d582 1
a582 1
	if {[string equal $Priv(menuBar) {}]} {
d593 1
a593 1
	if {[string compare $menu [grab current $menu]]} {
d600 1
a600 1
	if {[string equal [tk windowingsystem] "x11"]} {
d619 1
a619 1
    if {[string equal [$menu index active] "none"]} {
d622 3
a624 3
    if {[string equal [$menu type active] "cascade"]
          && [string equal [winfo containing $rootx $rooty] \
                  [$menu entrycget active -menu]]} {
d644 1
a644 1
    if {$buttonRelease && [string equal $Priv(window) {}]} {
d655 1
a655 1
    if {[string equal [$w type active] "cascade"]} {
d659 1
a659 1
    } elseif {[string equal [$w type active] "tearoff"]} {
d662 1
a662 1
    } elseif {[string equal [$w cget -type] "menubar"]} {
d704 1
a704 1
    if {[string compare [winfo class $parent] "Menu"]} {
d706 1
a706 1
    } elseif {[string equal [$parent cget -type] "menubar"]} {
d718 1
a718 1
    if {[string equal [$menu cget -type] "menubar"]} {
d726 1
a726 1
    if {[string equal [$menu cget -type] "menubar"]} {
d734 1
a734 1
    if {[string equal [$menu cget -type] "menubar"]} {
d742 1
a742 1
    if {[string equal [$menu cget -type] "menubar"]} {
d764 1
a764 1
    if {[string equal $direction "right"]} {
d768 1
a768 1
	if {[string equal [$menu type active] "cascade"]} {
d771 1
a771 1
	    if {[string compare $m2 ""]} {
d777 3
a779 3
	    while {[string compare $parent "."]} {
		if {[string equal [winfo class $parent] "Menu"] \
			&& [string equal [$parent cget -type] "menubar"]} {
d790 1
a790 1
	if {[string equal [winfo class $m2] "Menu"]} {
d797 1
a797 1
	    if {[string compare [$m2 cget -type] "menubar"]} {
d803 1
a803 1
    # Can't traverse into or out of a cascaded menu.  Go to the next
d807 4
a810 6
    if {[string equal [winfo class $m2] "Menu"]} {
	if {[string equal [$m2 cget -type] "menubar"]} {
	    tk_menuSetFocus $m2
	    MenuNextEntry $m2 -1
	    return
	}
d814 1
a814 1
    if {[string equal $w ""]} {
d828 4
a831 4
	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"]} {
d834 1
a834 1
	if {[string equal $mb $w]} {
d853 1
a853 2

    if {[string equal [$menu index last] "none"]} {
d859 1
a859 1
    if {[string equal $active "none"]} {
d893 1
a893 2
    if {[string equal [$menu type $i] "cascade"] \
	    && [string equal [$menu cget -type] "menubar"]} {
d895 1
a895 1
	if {[string compare $cascade ""]} {
d927 1
a927 1
        if {[string compare [winfo toplevel $w] [winfo toplevel $child]]} {
d930 3
a932 3
	if {[string equal [winfo class $child] "Menu"] && \
		[string equal [$child cget -type] "menubar"]} {
	    if {[string equal $char ""]} {
d937 1
a937 1
		if {[string equal [$child type $i] "separator"]} {
d942 2
a943 3
		if {[string equal $char [string tolower $char2]] \
			|| [string equal $char ""]} {
		    if {[string compare [$child entrycget $i -state] "disabled"]} {
d953 1
a953 1
        if {[string compare [winfo toplevel $w] [winfo toplevel $child]]} {
d956 1
a956 1
	switch [winfo class $child] {
d960 2
a961 3
		if {[string equal $char [string tolower $char2]] \
			|| [string equal $char ""]} {
		    if {[string compare [$child cget -state] "disabled"]} {
d969 1
a969 1
		if {[string compare $match ""]} {
d992 1
a992 1
    if {[string equal $char ""]} {
d995 2
a996 3
    while {[string equal [winfo class $w] "Menu"]} {
	if {[string compare [$w cget -type] "menubar"] \
		&& [string equal $Priv(postedMb) ""]} {
d999 1
a999 1
	if {[string equal [$w cget -type] "menubar"]} {
d1005 2
a1006 2
    if {[string compare $w ""]} {
	if {[string equal [winfo class $w] "Menu"]} {
d1030 2
a1031 2
    if {[string compare $w ""]} {
	if {[string equal [winfo class $w] "Menu"]} {
d1056 1
a1056 1
    if {[string equal $char ""]} {
d1061 1
a1061 1
    if {[string equal $last "none"]} {
d1069 2
a1070 2
	if {[string equal $char [string tolower $char2]]} {
	    if {[string equal [$w type $i] "cascade"]} {
d1075 1
a1075 1
		if {[string compare $m2 ""]} {
d1099 1
a1099 1
    if {[string equal $menu ""]} {
d1103 1
a1103 1
    if {[string compare [$menu index active] "none"]} {
d1107 1
a1107 1
    if {[string equal $last "none"]} {
d1112 1
a1112 2
		&& [string compare $state "disabled"] \
		&& [string compare [$menu type $i] "tearoff"]} {
d1119 2
a1120 2
	    if {[string equal [$menu type $i] "cascade"] && \
		[string equal [$menu cget -type] "menubar"]} {
d1122 1
a1122 1
		if {[string compare $cascade ""]} {
d1150 1
a1150 1
    if {[string equal $last "none"]} {
d1155 1
a1155 1
	    if {[string equal $label $s]} {
d1178 1
a1178 1
    if {[string compare $entry {}]} {
d1243 1
a1243 1
          if {[string equal $Priv(grabStatus) "global"]} {
d1255 1
a1255 1
    if {![info exists Priv(focus)] || [string equal $Priv(focus) {}]} {
d1264 2
a1265 2
    if {[string equal $Priv(activeMenu) $menu] \
          && [string equal $Priv(activeItem) [$menu index active]]} {
@


1.20
log
@	* doc/menubutton.n:
	* library/menu.tcl (::tk::MbPost): make menubuttons that post
	above or below reverse direction when not enough space is available.
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: menu.tcl,v 1.19 2003/06/26 17:15:48 vincentdarley Exp $
d690 4
a693 1
	MenuUnpost $w
@


1.19
log
@Windows menu popup location fix
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: menu.tcl,v 1.18 2002/08/31 06:12:28 das Exp $
d283 4
d292 5
d348 1
a348 1
    	    	}  
@


1.18
log
@	*** macosx-8-4-branch merged into the mainline [tcl patch #602770] ***

	* generic/tk.decls:
	* generic/tkInt.decls: added new "aqua" specific entries to the
	stubs tables. Changed all "unix" entries to "x11" to allow us to
	distinguish and build both "aqua" on MacOSX and "x11" on MacOSX.

	* generic/tk.h: added a #ifnded RESOURCE_INCLUDED so that tk.h can
	be passed to the resource compiler.

	* generic/tkCmds.c (Tk_TkObjCmd): added [tk windowingsystem]
	subcommand: returns "x11" when running on X11, "win32" on Windows,
	"classic" on MacOS9 and "aqua" on MacOSX Aqua (i.e. Carbon)

	* generic/tkFont.c (TkFontGetFirstTextLayout): new private function
	returning the first chunk of a Tk_TextLayout, i.e. until the first
	font change on the first line (or the whole first line if there is
	no such font change).

	* generic/tkMain.c: made Tcl_ThreadDataKey static

	* library/demos/puzzle.tcl: fixed button metrics for aqua

	* tests/cursor.test: check for presence of arrow cursor instead of
	heart cursor

	* xlib/xcolors.c: changed xColors static initialization to more
	standard C

	* macosx/Wish.pbproj/jingham.pbxuser (new):
	* macosx/Wish.pbproj/project.pbxproj (new): project for Apple's
	ProjectBuilder IDE.

	* macosx/Makefile (new): simple makefile for building the project
	from the command line via the ProjectBuilder tool 'pbxbuild'.

	* macosx/tkMacOSXAppInit.c (new): macosx specific AppInit looking
	for a AppMain.tcl file in its bundled Resources/Scripts folder. If
	present, argv[1] is set to that file and the Scripts folder is
	added to the auto_path. This allows tk apps to embed scripts within
	their bundle directory structure.

	* macosx/tkMacOSXInit.c (new): macosx adapted version of
	tkUnixInit.c: we initialize & cache the Carbon native encoding
	(e.g. 'macRoman') and try to find the tk script library files
	inside Tk packaged as a framework.

	* macosx/tkMacOSXNotify.c (new): new macosx specific merged
	Carbon/select-based notifier.

	* macosx/tkMacOSXEvent.c (new):
	* macosx/tkMacOSXEvent.h (new):
	* macosx/tkMacOSXKeyEvent.c (new):
	* macosx/tkMacOSXMouseEvent.c (new):
	* macosx/tkMacOSXWindowEvent.c (new): new macosx specific event
	handling functionality.

	* macosx/tkMacOSX.h (new):
	* macosx/tkMacOSXBitmap.c (new):
	* macosx/tkMacOSXButton.c (new):
	* macosx/tkMacOSXClipboard.c (new):
	* macosx/tkMacOSXColor.c (new):
	* macosx/tkMacOSXConfig.c (new):
	* macosx/tkMacOSXCursor.c (new):
	* macosx/tkMacOSXDefault.h (new):
	* macosx/tkMacOSXDialog.c (new):
	* macosx/tkMacOSXDraw.c (new):
	* macosx/tkMacOSXEmbed.c (new):
	* macosx/tkMacOSXFont.c (new):
	* macosx/tkMacOSXHLEvents.c (new):
	* macosx/tkMacOSXInt.h (new):
	* macosx/tkMacOSXKeyboard.c (new):
	* macosx/tkMacOSXMenu.c (new):
	* macosx/tkMacOSXMenubutton.c (new):
	* macosx/tkMacOSXMenus.c (new):
	* macosx/tkMacOSXPort.h (new):
	* macosx/tkMacOSXRegion.c (new):
	* macosx/tkMacOSXScale.c (new):
	* macosx/tkMacOSXScrlbr.c (new):
	* macosx/tkMacOSXSubwindows.c (new):
	* macosx/tkMacOSXTest.c (new):
	* macosx/tkMacOSXUtil.c (new):
	* macosx/tkMacOSXUtil.h (new):
	* macosx/tkMacOSXWm.c (new):
	* macosx/tkMacOSXWm.h (new):
	* macosx/tkMacOSXXStubs.c (new): macosx ports of classic mac Tk
	implementation in tk/mac.

	* macosx/tkMacOSXSend.c (new): only send to local interp
	implemented currently.

	* macosx/tkMacOSXDebug.h (new):
	* macosx/tkMacOSXDebug.c (new): new macosx specific functions for
	debugging MacOS events, regions, etc.

	* macosx/tkAboutDlg.r (new):
	* macosx/tkMacOSXApplication.r (new):
	* macosx/tkMacOSXCursors.r (new):
	* macosx/tkMacOSXLibrary.r (new):
	* macosx/tkMacOSXMenu.r (new):
	* macosx/tkMacOSXResource.r (new):
	* macosx/tkMacOSXXCursors.r (new):
	* macosx/tclets.r (new): sources for Rez resource compiler.

	* macosx/Wish.icns (new): Wish application icon.

	* generic/tk.h:
	* generic/default.h:
	* generic/tkBind.c:
	* generic/tkCmds.c:
	* generic/tkGrab.c:
	* generic/tkPointer.c:
	* generic/tkPort.h:
	* generic/tkSelect.c:
	* generic/tkStubLib.c:
	* generic/tkTest.c:
	* generic/tkText.c:
	* generic/tkWindow.c:
	* unix/tkUnix3d.c:
	* xlib/xgc.c:
	* xlib/X11/X.h:
	* xlib/X11/Xlib.h:
	* xlib/X11/Xutil.h: added #includes and #ifdefs for macosx

	* library/bgerror.tcl:
	* library/button.tcl:
	* library/console.tcl:
	* library/dialog.tcl:
	* library/entry.tcl:
	* library/listbox.tcl:
	* library/menu.tcl:
	* library/msgbox.tcl:
	* library/scrlbar.tcl:
	* library/spinbox.tcl:
	* library/text.tcl:
	* library/tk.tcl:
	* library/demos/menu.tcl:
	* library/demos/menubu.tcl:
	* library/demos/widget: check [tk windowingsystem] instead of
	and/or in addition to $tcl_platform(platform).

	* generic/tkInt.h:
	* mac/tkMacBitmap.c:
	* mac/tkMacWm.c: added missing CONSTification

	* generic/tkIntDecls.h:
	* generic/tkIntPlatDecls.h:
	* generic/tkIntXlibDecls.h:
	* generic/tkPlatDecls.h:
	* generic/tkStubInit.c: regen
@
text
@d7 1
a7 1
# RCS: @@(#) $Id$
d1189 5
a1193 1
	# We need to fix some problems with menu posting on Windows.
d1195 1
a1195 1
		- $y - [winfo reqheight $menu]}]
@


1.18.2.1
log
@	* library/menu.tcl (::tk::MbPost): make menubuttons that post
	above or below reverse direction when not enough space is available.
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: menu.tcl,v 1.18 2002/08/31 06:12:28 das Exp $
a282 4
		# if we go offscreen to the top, show as 'below'
		if {$y < 0} {
		    set y [expr {[winfo rooty $w] + [winfo height $w]}]
		}
a287 5
		# 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}]
		}
d339 1
a339 1
    	    	}
@


1.18.2.2
log
@change tk_popup to have sticky menus
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: menu.tcl,v 1.18.2.1 2004/02/04 00:23:04 hobbs Exp $
d690 1
a690 4
	set active [$w index active]
	if {$Priv(popup) eq "" || $active ne "none"} {
	    MenuUnpost $w
	}
@


1.18.2.3
log
@	* library/menu.tcl (::tk::PostOverPoint): correct menu post near
	bottom of screen on Windows. [Bug 1353416]
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: menu.tcl,v 1.18.2.2 2005/05/27 18:00:59 tmh Exp $
d1190 1
a1190 1
    if {$entry ne ""} {
d1200 2
a1201 6
    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.
d1203 1
a1203 1
		- $y - [winfo reqheight $menu] - 10}]
d1268 1
a1268 1

@


1.18.2.4
log
@        * library/bgerror.tcl:  Updates to use Tcl 8.4 features. [Patch 1237759]        * library/button.tcl:
        * library/choosedir.tcl:
        * library/clrpick.tcl:
        * library/comdlg.tcl:
        * library/console.tcl:
        * library/dialog.tcl:
        * library/entry.tcl:
        * library/focus.tcl:
        * library/listbox.tcl:
        * library/menu.tcl:
        * library/msgbox.tcl:
        * library/palette.tcl:
        * library/panedwindow.tcl:
        * library/safetk.tcl:
        * library/scale.tcl:
        * library/scrlbar.tcl:
        * library/spinbox.tcl:
        * library/tearoff.tcl:
        * library/text.tcl:
        * library/tk.tcl:
        * library/tkfbox.tcl:
        * library/xmfbox.tcl:
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: menu.tcl,v 1.18.2.3 2005/12/01 17:47:14 hobbs Exp $
d172 1
a172 1
if {[tk windowingsystem] eq "x11"} {
d202 1
a202 1
    if {$Priv(inMenubutton) ne ""} {
d206 1
a206 1
    if {[$w cget -state] ne "disabled"} {
d225 1
a225 1
    if {[$w cget -state] eq "active"} {
d251 1
a251 1
    if {$menu eq ""} {
d260 1
a260 1
    if {$cur ne ""} {
d341 1
a341 1
		    if {$y eq ""} {
d403 1
a403 1
	if {$mb ne ""} {
d409 1
a409 1
	} elseif {$Priv(popup) ne ""} {
d412 2
a413 1
	} elseif {[$menu cget -type] ne "menubar" && [$menu cget -type] ne "tearoff"} {
d421 2
a422 1
		if {[winfo class $parent] ne "Menu" || ![winfo ismapped $parent]} {
d429 2
a430 1
		if {$type eq "menubar" || $type eq "tearoff"} {
d435 1
a435 1
	    if {[$menu cget -type] ne "menubar"} {
d444 1
a444 1
	if {$menu ne ""} {
d446 1
a446 1
	    if {$grab ne ""} {
d475 1
a475 1
    if {$Priv(inMenubutton) eq $w} {
d479 4
a482 3
    if {$new ne $Priv(inMenubutton) \
	    && ($new eq "" || [winfo toplevel $new] eq [winfo toplevel $w])} {
	if {$Priv(inMenubutton) ne ""} {
d485 2
a486 2
	if {$new ne "" \
		&& [winfo class $new] eq "Menubutton" \
d489 1
a489 1
	    if {$upDown eq "down"} {
d536 4
a539 3
    if {$menu eq $Priv(window)} {
	if {[$menu cget -type] eq "menubar"} {
	    if {[info exists Priv(focus)] && $menu ne $Priv(focus)} {
d576 2
a577 1
    if {$Priv(postedMb) ne "" && [winfo viewable $Priv(postedMb)]} {
d580 2
a581 2
	while {[$menu cget -type] eq "normal" \
		&& [winfo class [winfo parent $menu]] eq "Menu" \
d586 1
a586 1
	if {$Priv(menuBar) eq ""} {
d597 1
a597 1
	if {$menu ne [grab current $menu]} {
d604 1
a604 1
	if {[tk windowingsystem] eq "x11"} {
d623 1
a623 1
    if {[$menu index active] eq "none"} {
d626 3
a628 2
    if {[$menu type active] eq "cascade" \
	    && [winfo containing $rootx $rooty] eq [$menu entrycget active -menu]} {
d648 1
a648 1
    if {$buttonRelease && $Priv(window) eq ""} {
d659 1
a659 1
    if {[$w type active] eq "cascade"} {
d663 1
a663 1
    } elseif {[$w type active] eq "tearoff"} {
d666 1
a666 1
    } elseif {[$w cget -type] eq "menubar"} {
d708 1
a708 1
    if {[winfo class $parent] ne "Menu"} {
d710 1
a710 1
    } elseif {[$parent cget -type] eq "menubar"} {
d722 1
a722 1
    if {[$menu cget -type] eq "menubar"} {
d730 1
a730 1
    if {[$menu cget -type] eq "menubar"} {
d738 1
a738 1
    if {[$menu cget -type] eq "menubar"} {
d746 1
a746 1
    if {[$menu cget -type] eq "menubar"} {
d768 1
a768 1
    if {$direction eq "right"} {
d772 1
a772 1
	if {[$menu type active] eq "cascade"} {
d775 1
a775 1
	    if {$m2 ne ""} {
d781 3
a783 2
	    while {$parent ne "."} {
		if {[winfo class $parent] eq "Menu" && [$parent cget -type] eq "menubar"} {
d794 1
a794 1
	if {[winfo class $m2] eq "Menu"} {
d801 1
a801 1
	    if {[$m2 cget -type] ne "menubar"} {
d811 2
a812 2
    if {[winfo class $m2] eq "Menu"} {
	if {[$m2 cget -type] eq "menubar"} {
d820 1
a820 1
    if {$w eq ""} {
d834 4
a837 4
	if {[winfo class $mb] eq "Menubutton" \
		&& [$mb cget -state] ne "disabled" \
		&& [$mb cget -menu] ne "" \
		&& [[$mb cget -menu] index last] ne "none"} {
d840 1
a840 1
	if {$mb eq $w} {
d859 2
a860 1
    if {[$menu index last] eq "none"} {
d866 1
a866 1
    if {$active eq "none"} {
d900 2
a901 1
    if {[$menu type $i] eq "cascade" && [$menu cget -type] eq "menubar"} {
d903 1
a903 1
	if {$cascade ne ""} {
d935 1
a935 1
        if {[winfo toplevel $w] ne [winfo toplevel $child]} {
d938 3
a940 2
	if {[winfo class $child] eq "Menu" && [$child cget -type] eq "menubar"} {
	    if {$char eq ""} {
d945 1
a945 1
		if {[$child type $i] eq "separator"} {
d950 3
a952 2
		if {$char eq [string tolower $char2] || $char eq ""} {
		    if {[$child entrycget $i -state] ne "disabled"} {
d962 1
a962 1
        if {[winfo toplevel $w] ne [winfo toplevel $child]} {
d969 3
a971 2
		if {$char eq [string tolower $char2] || $char eq ""} {
		    if {[$child cget -state] ne "disabled"} {
d979 1
a979 1
		if {$match ne ""} {
d1002 1
a1002 1
    if {$char eq ""} {
d1005 6
a1010 2
    while {[winfo class $w] eq "Menu"} {
	if {[$w cget -type] eq "menubar"} {
a1011 2
	} elseif {$Priv(postedMb) eq ""} {
	    return
d1016 2
a1017 2
    if {$w ne ""} {
	if {[winfo class $w] eq "Menu"} {
d1041 2
a1042 2
    if {$w ne ""} {
	if {[winfo class $w] eq "Menu"} {
d1067 1
a1067 1
    if {$char eq ""} {
d1072 1
a1072 1
    if {$last eq "none"} {
d1080 2
a1081 2
	if {$char eq [string tolower $char2]} {
	    if {[$w type $i] eq "cascade"} {
d1086 1
a1086 1
		if {$m2 ne ""} {
d1110 1
a1110 1
    if {$menu eq ""} {
d1114 1
a1114 1
    if {[$menu index active] ne "none"} {
d1118 1
a1118 1
    if {$last eq "none"} {
d1123 2
a1124 2
		&& $state ne "disabled" \
		&& [$menu type $i] ne "tearoff"} {
d1131 2
a1132 1
	    if {[$menu type $i] eq "cascade" &&	[$menu cget -type] eq "menubar"} {
d1134 1
a1134 1
		if {$cascade ne ""} {
d1162 1
a1162 1
    if {$last eq "none"} {
d1167 1
a1167 1
	    if {$label eq $s} {
d1255 1
a1255 1
          if {$Priv(grabStatus) eq "global"} {
d1267 1
a1267 1
    if {![info exists Priv(focus)] || $Priv(focus) eq ""} {
d1276 2
a1277 1
    if {$Priv(activeMenu) eq $menu && $Priv(activeItem) eq [$menu index active]} {
@


1.18.2.5
log
@	Backport from HEAD of Aqua changes from 2007-10-12 to 2007-11-09
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: menu.tcl,v 1.18.2.4 2006/01/25 18:21:41 dgp Exp $
a11 1
# Copyright (c) 2007 Daniel A. Steffen <das@@users.sourceforge.net>
d206 1
a206 1
    if {[$w cget -state] ne "disabled" && [tk windowingsystem] ne "aqua"} {
d225 1
a225 1
    if {[$w cget -state] eq "active" && [tk windowingsystem] ne "aqua"} {
d264 1
d266 1
a266 6
    if {[tk windowingsystem] ne "aqua"} {
	set Priv(relief) [$w cget -relief]
	$w configure -relief raised
    } else {
	$w configure -state active
    }
d408 1
a408 5
	    if {[tk windowingsystem] ne "aqua"} {
		$mb configure -relief $Priv(relief)
	    } else {
		$mb configure -state normal
	    }
@


1.17
log
@	* library/menu.tcl: corrected menus from being posted offscreen
	on Windows. [Bug #464451] (darley)
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: menu.tcl,v 1.16 2002/06/11 18:59:25 jenglish Exp $
d124 1
a124 1
	    if {$tcl_platform(platform) eq "unix"} {
d172 1
a172 1
if {[string equal $tcl_platform(platform) "unix"]} {
d254 1
a254 1
    set tearoff [expr {$tcl_platform(platform) eq "unix" \
d446 1
a446 1
	if {$tcl_platform(platform) ne "unix"} {
d502 1
a502 1
    set tearoff [expr {$tcl_platform(platform) eq "unix" || \
d595 1
a595 1
	if {[string equal $tcl_platform(platform) "unix"]} {
d1289 1
a1289 1
    if {$tcl_platform(platform) eq "unix" && [winfo viewable $menu]} {
@


1.16
log
@fix for bug report #530212 "Bad Window Path Name in tkMenuFind"
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: menu.tcl,v 1.15 2001/11/27 14:08:04 drh Exp $
d93 1
a93 1
    if {[string compare $tk::Priv(inMenubutton) ""]} {
d122 3
a124 3
    if {[string equal [%W cget -type] "tearoff"]} {
	if {[string compare "%m" "NotifyUngrab"]} {
	    if {[string equal $tcl_platform(platform) "unix"]} {
d247 1
a247 2
    if {[string equal [$w cget -state] "disabled"] || \
	    [string equal $w $Priv(postedMb)]} {
d254 2
a255 2
    set tearoff [expr {[string equal $tcl_platform(platform) "unix"] \
	    || [string equal [$menu cget -type] "tearoff"]}]
d283 1
a283 1
    	    	$menu post $x $y
d288 1
a288 1
    	    	$menu post $x $y
d303 3
a305 2
    	    	$menu post $x $y
		if {[string compare $entry {}] && [string compare [$menu entrycget $entry -state] "disabled"]} {
d323 3
a325 2
    	    	$menu post $x $y
		if {[string compare $entry {}] && [string compare [$menu entrycget $entry -state] "disabled"]} {
d338 1
a338 1
	    	    $menu post [winfo rootx $w] [expr {[winfo rooty $w]+[winfo height $w]}]
d432 1
a432 1
    if {($Priv(tearoff) != 0) || [string compare $Priv(menuBar) ""]} {
d442 1
a442 1
	if {[string compare $Priv(menuBar) ""]} {
d446 1
a446 1
	if {[string compare $tcl_platform(platform) "unix"]} {
d502 4
a505 5
    set tearoff [expr {[string equal $tcl_platform(platform) "unix"] || \
	    ([string compare $menu {}] && \
	    [string equal [$menu cget -type] "tearoff"])}]
    if {($tearoff != 0) && [string equal $Priv(postedMb) $w] \
	    && [string equal $Priv(inMenubutton) $w]} {
d873 3
a875 3
	    if {$state!="disabled" && 
		($i!=0 || [$menu cget -type]!="tearoff" 
			|| [$menu type 0]!="tearoff")} {
d1188 16
d1205 1
a1205 2
    if {[string compare $entry {}] \
	    && [string compare [$menu entrycget $entry -state] "disabled"]} {
d1222 1
a1222 1
    if {[string compare $Priv(oldGrab) ""]} {
d1234 1
a1234 2
    if {[string compare $Priv(oldGrab) ""]} {

d1285 1
a1285 2
    if {[string compare $Priv(popup) ""] \
	    || [string compare $Priv(postedMb) ""]} {
d1289 1
a1289 2
    if {[string equal $tcl_platform(platform) "unix"] \
	    && [winfo viewable $menu]} {
@


1.15
log
@When a menu is torn off, a new "clone" menu is created which is an exact
copy of the original.  The copy even includes the tearoff bar, though the
tearoff bar is not displayed.  But even though it wasn't displayed, the
tearoff bar on the tearoff menu could be visited using keyboard traversal.
This change makes it so that the (invisible) tearoff bar of tearoff menus
is no longer visited on keyboard traversal.
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: menu.tcl,v 1.14 2001/11/16 22:54:22 hobbs Exp $
d923 1
a923 2
        if {[string compare [winfo toplevel [focus]] \
		[winfo toplevel $child]]} {
d950 1
a950 2
        if {[string compare [winfo toplevel [focus]] \
		[winfo toplevel $child]]} {
@


1.14
log
@	* library/menu.tcl: corrected menu traversal code on Unix to
	better handle entering cascades.  [Patch #481219]
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: menu.tcl,v 1.13 2001/08/01 16:21:11 dgp Exp $
d873 3
a875 1
	    if {[string compare $state "disabled"]} {
@


1.13
log
@	Merged changes from feature branch dgp-privates-into-namespace,
	implementing TIP 44.  All Tk commands and variables matching
	tk[A-Z]* are now in the ::tk namespace.
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: menu.tcl,v 1.12 2000/04/17 19:32:00 ericm Exp $
d783 6
a789 9
		$menu activate none
		GenerateMenuSelect $menu
		tk_menuSetFocus $m2
		
		# This code unposts any posted submenu in the parent.
		
		set tmp [$m2 index active]
		$m2 activate none
		$m2 activate $tmp
d885 3
a887 1
    if {[string equal [$menu type $i] "cascade"]} {
@


1.13.2.1
log
@First checkin of support for Tk on Mac OS X.
@
text
@d7 1
a7 1
# RCS: @@(#) $Id$
d124 1
a124 1
	    if {[string equal $tcl_platform(windowingsystem) "x11"]} {
d172 1
a172 1
if {[string equal $tcl_platform(windowingsystem) "x11"]} {
d255 1
a255 1
    set tearoff [expr {[string equal $tcl_platform(windowingsystem) "x11"] \
d445 1
a445 1
	if {[string compare $tcl_platform(windowingsystem) "x11"]} {
d501 1
a501 1
    set tearoff [expr {[string equal $tcl_platform(windowingsystem) "x11"] || \
d595 1
a595 1
	if {[string equal $tcl_platform(windowingsystem) "x11"]} {
d1277 1
a1277 1
    if {[string equal $tcl_platform(windowingsystem) "x11"] \
@


1.13.2.2
log
@Merge with current TOT
Added support for the wm stackorder command
Fixed crash when selecting Menu items in the Application menu that we didn't
put there.
Added first bits of the use of CG for low-level drawing.  The line-drawing works,
the rest doesn't yet.  You have to set the file static useCGDrawing to 1 and
rebuild to activate this code.
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: menu.tcl,v 1.13.2.1 2001/10/15 09:22:00 wolfsuit Exp $
a782 6
	    $menu activate none
	    GenerateMenuSelect $menu
	    tk_menuSetFocus $m2

	    $m2 postcascade none

d784 9
d876 1
a876 3
	    if {$state!="disabled" && 
		($i!=0 || [$menu cget -type]!="tearoff" 
			|| [$menu type 0]!="tearoff")} {
d888 1
a888 3

    if {[string equal [$menu type $i] "cascade"] \
	    && [string equal [$menu cget -type] "menubar"]} {
@


1.13.2.3
log
@merged with trunk at tag macosx-8-4-merge-2002-08-20-trunk
@
text
@d7 1
a7 1
# RCS: @@(#) $Id$
d93 1
a93 1
    if {$tk::Priv(inMenubutton) ne ""} {
d122 3
a124 3
    if {[%W cget -type] eq "tearoff"} {
	if {"%m" ne "NotifyUngrab"} {
	    if {$tcl_platform(windowingsystem) eq "x11"} {
d247 2
a248 1
    if {[$w cget -state] eq "disabled" || $w eq $Priv(postedMb)} {
d255 2
a256 2
    set tearoff [expr {$tcl_platform(windowingsystem) eq "x11" \
	    || [$menu cget -type] eq "tearoff"}]
d284 1
a284 1
		PostOverPoint $menu $x $y
d289 1
a289 1
		PostOverPoint $menu $x $y
d304 2
a305 3
		PostOverPoint $menu $x $y
		if {$entry ne "" \
			&& [$menu entrycget $entry -state] ne "disabled"} {
d323 2
a324 3
		PostOverPoint $menu $x $y
		if {$entry ne "" \
			&& [$menu entrycget $entry -state] ne "disabled"} {
d337 1
a337 1
		    PostOverPoint $menu [winfo rootx $w] [expr {[winfo rooty $w]+[winfo height $w]}]
d431 1
a431 1
    if {($Priv(tearoff) != 0) || $Priv(menuBar) ne ""} {
d441 1
a441 1
	if {$Priv(menuBar) ne ""} {
d445 1
a445 1
	if {$tcl_platform(windowingsystem) ne "x11"} {
d501 5
a505 4
    set tearoff [expr {$tcl_platform(windowingsystem) eq "x11" || \
	    ($menu ne "" && [$menu cget -type] eq "tearoff")}]
    if {($tearoff != 0) && $Priv(postedMb) eq $w \
	    && $Priv(inMenubutton) eq $w} {
d873 3
a875 3
	    if {$state ne "disabled" && \
		    ($i!=0 || [$menu cget -type] ne "tearoff" \
		    || [$menu type 0] ne "tearoff")} {
d923 2
a924 1
        if {[string compare [winfo toplevel $w] [winfo toplevel $child]]} {
d951 2
a952 1
        if {[string compare [winfo toplevel $w] [winfo toplevel $child]]} {
a1189 16
    if {$tcl_platform(platform) == "windows"} {
	# We need to fix some problems with menu posting on Windows.
	set yoffset [expr {[winfo screenheight $menu] \
		- $y - [winfo reqheight $menu]}]
	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
	}
    }
d1191 2
a1192 1
    if {$entry ne "" && [$menu entrycget $entry -state] ne "disabled"} {
d1209 1
a1209 1
    if {$Priv(oldGrab) ne ""} {
d1221 2
a1222 1
    if {$Priv(oldGrab) ne ""} {
d1273 2
a1274 1
    if {$Priv(popup) ne "" || $Priv(postedMb) ne ""} {
d1278 2
a1279 1
    if {$tcl_platform(windowingsystem) eq "x11" && [winfo viewable $menu]} {
@


1.13.2.4
log
@various project cleanups & enhancements
added macosx/Makefile to facilitate building from cli
added [tk windowingsystem] and removed $::tcl_plaform(windowingsystem)
changed all runtime library references to the above
removed duplicate entries in tk.decls & tkInt.decls
CONSTification and other small changes in macosx/ to remove compiler warnings
@
text
@d124 1
a124 1
	    if {[tk windowingsystem] eq "x11"} {
d172 1
a172 1
if {[string equal [tk windowingsystem] "x11"]} {
d254 1
a254 1
    set tearoff [expr {[tk windowingsystem] eq "x11" \
d446 1
a446 1
	if {[tk windowingsystem] ne "x11"} {
d502 1
a502 1
    set tearoff [expr {[tk windowingsystem] eq "x11" || \
d595 1
a595 1
	if {[string equal [tk windowingsystem] "x11"]} {
d1289 1
a1289 1
    if {[tk windowingsystem] eq "x11" && [winfo viewable $menu]} {
@


1.12
log
@* doc/menu.n: Added note regarding rendering of
checkbuttons/radiobuttons in menubars on different platforms --
some systems do not draw indicators for check/radiobuttons in
menubars.

* library/menu.tcl: Corrected behavior of
checkbuttons/commands/radiobuttons in menubars [Bug: 630].
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: menu.tcl,v 1.11 2000/03/31 09:24:11 hobbs Exp $
d18 1
a18 1
# Elements of tkPriv that are used in this file:
d23 2
a24 2
# grabGlobal -		Used in conjunction with tkPriv(oldGrab):  if
#			tkPriv(oldGrab) is non-empty, then tkPriv(grabGlobal)
d65 1
a65 1
#    tkPriv(postedMb) identifies the posted menubutton.
d67 1
a67 1
#    tkPriv(postedMb) is empty, and menu's type is "tearoff".
d69 2
a70 2
#    style tkPriv(postedMb) identifies the posted menubutton.
# 4. As a popup menu.  In this style tkPriv(postedMb) is empty and
d72 1
a72 1
# 5. As a pulldown from a menubar. The variable tkPriv(menubar) has
d87 1
a87 1
    tkMbEnter %W
d90 1
a90 1
    tkMbLeave %W
d93 2
a94 2
    if {[string compare $tkPriv(inMenubutton) ""]} {
	tkMbPost $tkPriv(inMenubutton) %X %Y
d98 1
a98 1
    tkMbMotion %W up %X %Y
d101 1
a101 1
    tkMbMotion %W down %X %Y
d104 1
a104 1
    tkMbButtonUp %W
d107 2
a108 2
    tkMbPost %W
    tkMenuFirstEntry [%W cget -menu]
d121 1
a121 1
    set tkPriv(window) %W
d129 1
a129 1
    tkMenuMotion %W %x %y %s
d133 1
a133 1
    tkMenuLeave %W %X %Y %s
d136 1
a136 1
    tkMenuMotion %W %x %y %s
d139 1
a139 1
    tkMenuButtonDown %W
d142 1
a142 1
   tkMenuInvoke %W 1
d145 1
a145 1
    tkMenuInvoke %W 0
d148 1
a148 1
    tkMenuInvoke %W 0
d151 1
a151 1
    tkMenuEscape %W
d154 1
a154 1
    tkMenuLeftArrow %W
d157 1
a157 1
    tkMenuRightArrow %W
d160 1
a160 1
    tkMenuUpArrow %W
d163 1
a163 1
    tkMenuDownArrow %W
d166 1
a166 1
    tkTraverseWithinMenu %W %A
d174 1
a174 1
	tkTraverseToMenu %W %A
d178 1
a178 1
	tkFirstMenu %W
d182 1
a182 1
	tkTraverseToMenu %W %A
d186 1
a186 1
	tkFirstMenu %W
d190 1
a190 1
# tkMbEnter --
d194 1
a194 1
# The procedure tkMbB1Enter is invoked if the button is down.
d199 2
a200 2
proc tkMbEnter w {
    global tkPriv
d202 2
a203 2
    if {[string compare $tkPriv(inMenubutton) ""]} {
	tkMbLeave $tkPriv(inMenubutton)
d205 1
a205 1
    set tkPriv(inMenubutton) $w
d211 1
a211 1
# tkMbLeave --
d218 2
a219 2
proc tkMbLeave w {
    global tkPriv
d221 1
a221 1
    set tkPriv(inMenubutton) {}
d230 1
a230 1
# tkMbPost --
d242 3
a244 2
proc tkMbPost {w {x {}} {y {}}} {
    global tkPriv errorInfo
d248 1
a248 1
	    [string equal $w $tkPriv(postedMb)]} {
d260 1
a260 1
    set cur $tkPriv(postedMb)
d262 1
a262 1
	tkMenuUnpost {}
d264 2
a265 2
    set tkPriv(cursor) [$w cget -cursor]
    set tkPriv(relief) [$w cget -relief]
d269 2
a270 2
    set tkPriv(postedMb) $w
    set tkPriv(focus) [focus]
d272 1
a272 1
    tkGenerateMenuSelect $menu
d294 1
a294 1
    	    	set entry [tkMenuFindName $menu [$w cget -text]]
d307 1
a307 1
		    tkGenerateMenuSelect $menu
d313 1
a313 1
    	    	set entry [tkMenuFindName $menu [$w cget -text]]
d326 1
a326 1
		    tkGenerateMenuSelect $menu
d335 1
a335 1
	            tkPostOverPoint $menu $x $y [tkMenuFindName $menu [$w cget -text]]
d346 1
a346 1
	tkMenuUnpost {}
d351 1
a351 1
    set tkPriv(tearoff) $tearoff
d355 1
a355 1
	    tkSaveGrabInfo $w
d361 1
a361 1
# tkMenuUnpost --
d377 1
a377 1
proc tkMenuUnpost menu {
d379 2
a380 2
    global tkPriv
    set mb $tkPriv(postedMb)
d386 2
a387 2
    catch {focus $tkPriv(focus)}
    set tkPriv(focus) ""
d396 6
a401 6
	    set tkPriv(postedMb) {}
	    $mb configure -cursor $tkPriv(cursor)
	    $mb configure -relief $tkPriv(relief)
	} elseif {[string compare $tkPriv(popup) ""]} {
	    $tkPriv(popup) unpost
	    set tkPriv(popup) {}
d417 1
a417 1
		tkGenerateMenuSelect $parent
d431 1
a431 1
    if {($tkPriv(tearoff) != 0) || [string compare $tkPriv(menuBar) ""]} {
d440 4
a443 4
	tkRestoreOldGrab
	if {[string compare $tkPriv(menuBar) ""]} {
	    $tkPriv(menuBar) configure -cursor $tkPriv(cursor)
	    set tkPriv(menuBar) {}
d446 1
a446 1
	    set tkPriv(tearoff) 0
d451 1
a451 1
# tkMbMotion --
d462 2
a463 2
proc tkMbMotion {w upDown rootx rooty} {
    global tkPriv
d465 1
a465 1
    if {[string equal $tkPriv(inMenubutton) $w]} {
d469 1
a469 1
    if {[string compare $new $tkPriv(inMenubutton)] \
d472 2
a473 2
	if {[string compare $tkPriv(inMenubutton) ""]} {
	    tkMbLeave $tkPriv(inMenubutton)
d480 1
a480 1
		tkMbPost $new $rootx $rooty
d482 1
a482 1
		tkMbEnter $new
d488 1
a488 1
# tkMbButtonUp --
d496 2
a497 2
proc tkMbButtonUp w {
    global tkPriv
d504 3
a506 3
    if {($tearoff != 0) && [string equal $tkPriv(postedMb) $w] \
	    && [string equal $tkPriv(inMenubutton) $w]} {
	tkMenuFirstEntry [$tkPriv(postedMb) cget -menu]
d508 1
a508 1
	tkMenuUnpost {}
d512 1
a512 1
# tkMenuMotion --
d525 3
a527 3
proc tkMenuMotion {menu x y state} {
    global tkPriv
    if {[string equal $menu $tkPriv(window)]} {
d529 2
a530 2
	    if {[info exists tkPriv(focus)] && \
		    [string compare $menu $tkPriv(focus)]} {
d532 1
a532 1
		tkGenerateMenuSelect $menu
d536 1
a536 1
	    tkGenerateMenuSelect $menu
d544 1
a544 1
# tkMenuButtonDown --
d559 2
a560 2
proc tkMenuButtonDown menu {
    global tkPriv
d567 3
a569 3
    if {[string compare $tkPriv(postedMb) ""] && \
	    [winfo viewable $tkPriv(postedMb)]} {
	grab -global $tkPriv(postedMb)
d577 3
a579 3
	if {[string equal $tkPriv(menuBar) {}]} {
	    set tkPriv(menuBar) $menu
	    set tkPriv(cursor) [$menu cget -cursor]
d589 1
a589 1
	    tkSaveGrabInfo $menu
d601 1
a601 1
# tkMenuLeave --
d611 3
a613 3
proc tkMenuLeave {menu rootx rooty state} {
    global tkPriv
    set tkPriv(window) {}
d623 1
a623 1
    tkGenerateMenuSelect $menu
d626 1
a626 1
# tkMenuInvoke --
d636 2
a637 2
proc tkMenuInvoke {w buttonRelease} {
    global tkPriv
d639 1
a639 1
    if {$buttonRelease && [string equal $tkPriv(window) {}]} {
d647 1
a647 1
	tkMenuUnpost $w
d653 1
a653 1
	tkMenuFirstEntry $menu
d655 2
a656 2
	tkTearOffMenu $w
	tkMenuUnpost $w
d671 1
a671 1
	tkMenuUnpost $w
d681 1
a681 1
	tkMenuUnpost $w
d686 1
a686 1
# tkMenuEscape --
d694 1
a694 1
proc tkMenuEscape menu {
d697 1
a697 1
	tkMenuUnpost $menu
d699 2
a700 2
	tkMenuUnpost $menu
	tkRestoreOldGrab
d702 1
a702 1
	tkMenuNextMenu $menu left
d709 1
a709 1
proc tkMenuUpArrow {menu} {
d711 1
a711 1
	tkMenuNextMenu $menu left
d713 1
a713 1
	tkMenuNextEntry $menu -1
d717 1
a717 1
proc tkMenuDownArrow {menu} {
d719 1
a719 1
	tkMenuNextMenu $menu right
d721 1
a721 1
	tkMenuNextEntry $menu 1
d725 1
a725 1
proc tkMenuLeftArrow {menu} {
d727 1
a727 1
	tkMenuNextEntry $menu -1
d729 1
a729 1
	tkMenuNextMenu $menu left
d733 1
a733 1
proc tkMenuRightArrow {menu} {
d735 1
a735 1
	tkMenuNextEntry $menu 1
d737 1
a737 1
	tkMenuNextMenu $menu right
d741 1
a741 1
# tkMenuNextMenu --
d751 2
a752 2
proc tkMenuNextMenu {menu direction} {
    global tkPriv
d764 1
a764 1
		tkMenuFirstEntry $m2
d773 1
a773 1
		    tkMenuNextEntry $parent 1
d785 1
a785 1
		tkGenerateMenuSelect $menu
d805 1
a805 1
	    tkMenuNextEntry $m2 -1
d810 1
a810 1
    set w $tkPriv(postedMb)
d836 2
a837 2
    tkMbPost $mb
    tkMenuFirstEntry [$mb cget -menu]
d840 1
a840 1
# tkMenuNextEntry --
d849 1
a849 2
proc tkMenuNextEntry {menu count} {
    global tkPriv
d887 1
a887 1
    tkGenerateMenuSelect $menu
d895 1
a895 1
	    tkMenuFirstEntry $cascade
d900 1
a900 1
# tkMenuFind --
d916 1
a916 2
proc tkMenuFind {w char} {
    global tkPriv
d967 1
a967 1
		set match [tkMenuFind $child $char]
d977 1
a977 1
# tkTraverseToMenu --
d989 2
a990 2
proc tkTraverseToMenu {w char} {
    global tkPriv
d996 1
a996 1
		&& [string equal $tkPriv(postedMb) ""]} {
d1004 1
a1004 1
    set w [tkMenuFind [winfo toplevel $w] $char]
d1008 2
a1009 2
	    set tkPriv(window) $w
	    tkSaveGrabInfo $w
d1011 1
a1011 1
	    tkTraverseWithinMenu $w $char
d1013 2
a1014 2
	    tkMbPost $w
	    tkMenuFirstEntry [$w cget -menu]
d1019 1
a1019 1
# tkFirstMenu --
d1027 3
a1029 2
proc tkFirstMenu w {
    set w [tkMenuFind [winfo toplevel $w] ""]
d1033 2
a1034 2
	    set tkPriv(window) $w
	    tkSaveGrabInfo $w
d1036 1
a1036 1
	    tkMenuFirstEntry $w
d1038 2
a1039 2
	    tkMbPost $w
	    tkMenuFirstEntry [$w cget -menu]
d1044 1
a1044 1
# tkTraverseWithinMenu
d1055 1
a1055 1
proc tkTraverseWithinMenu {w char} {
d1076 1
a1076 1
		    tkMenuFirstEntry $m2
d1079 1
a1079 1
		tkMenuUnpost $w
d1087 1
a1087 1
# tkMenuFirstEntry --
d1091 1
a1091 1
# because of a previous call to tkPostOverPoint) then the active
d1098 1
a1098 1
proc tkMenuFirstEntry menu {
d1115 1
a1115 1
	    tkGenerateMenuSelect $menu
d1125 1
a1125 1
		    tkMenuFirstEntry $cascade
d1133 1
a1133 1
# tkMenuFindName --
d1144 1
a1144 1
proc tkMenuFindName {menu s} {
d1164 1
a1164 1
# tkPostOverPoint --
d1176 1
a1176 1
proc tkPostOverPoint {menu x y {entry {}}}  {
d1193 1
a1193 1
	tkGenerateMenuSelect $menu
d1197 2
a1198 2
# tkSaveGrabInfo --
# Sets the variables tkPriv(oldGrab) and tkPriv(grabStatus) to record
d1205 5
a1209 5
proc tkSaveGrabInfo w {
    global tkPriv
    set tkPriv(oldGrab) [grab current $w]
    if {[string compare $tkPriv(oldGrab) ""]} {
	set tkPriv(grabStatus) [grab status $tkPriv(oldGrab)]
d1213 1
a1213 1
# tkRestoreOldGrab --
d1217 2
a1218 2
proc tkRestoreOldGrab {} {
    global tkPriv
d1220 1
a1220 1
    if {[string compare $tkPriv(oldGrab) ""]} {
d1226 2
a1227 2
          if {[string equal $tkPriv(grabStatus) "global"]} {
		grab set -global $tkPriv(oldGrab)
d1229 1
a1229 1
		grab set $tkPriv(oldGrab)
d1232 1
a1232 1
	set tkPriv(oldGrab) ""
d1236 4
a1239 4
proc tk_menuSetFocus {menu} {
    global tkPriv
    if {![info exists tkPriv(focus)] || [string equal $tkPriv(focus) {}]} {
	set tkPriv(focus) [focus]
d1244 2
a1245 2
proc tkGenerateMenuSelect {menu} {
    global tkPriv
d1247 2
a1248 2
    if {[string equal $tkPriv(activeMenu) $menu] \
          && [string equal $tkPriv(activeItem) [$menu index active]]} {
d1252 2
a1253 2
    set tkPriv(activeMenu) $menu
    set tkPriv(activeItem) [$menu index active]
d1257 1
a1257 1
# tk_popup --
d1269 2
a1270 2
proc tk_popup {menu x y {entry {}}} {
    global tkPriv
d1272 3
a1274 3
    if {[string compare $tkPriv(popup) ""] \
	    || [string compare $tkPriv(postedMb) ""]} {
	tkMenuUnpost {}
d1276 1
a1276 1
    tkPostOverPoint $menu $x $y $entry
d1279 1
a1279 1
        tkSaveGrabInfo $menu
d1281 1
a1281 1
	set tkPriv(popup) $menu
@


1.12.4.1
log
@update to head
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: menu.tcl,v 1.15 2001/11/27 14:08:04 drh Exp $
d18 1
a18 1
# Elements of tk::Priv that are used in this file:
d23 2
a24 2
# grabGlobal -		Used in conjunction with tk::Priv(oldGrab):  if
#			tk::Priv(oldGrab) is non-empty, then tk::Priv(grabGlobal)
d65 1
a65 1
#    tk::Priv(postedMb) identifies the posted menubutton.
d67 1
a67 1
#    tk::Priv(postedMb) is empty, and menu's type is "tearoff".
d69 2
a70 2
#    style tk::Priv(postedMb) identifies the posted menubutton.
# 4. As a popup menu.  In this style tk::Priv(postedMb) is empty and
d72 1
a72 1
# 5. As a pulldown from a menubar. The variable tk::Priv(menubar) has
d87 1
a87 1
    tk::MbEnter %W
d90 1
a90 1
    tk::MbLeave %W
d93 2
a94 2
    if {[string compare $tk::Priv(inMenubutton) ""]} {
	tk::MbPost $tk::Priv(inMenubutton) %X %Y
d98 1
a98 1
    tk::MbMotion %W up %X %Y
d101 1
a101 1
    tk::MbMotion %W down %X %Y
d104 1
a104 1
    tk::MbButtonUp %W
d107 2
a108 2
    tk::MbPost %W
    tk::MenuFirstEntry [%W cget -menu]
d121 1
a121 1
    set tk::Priv(window) %W
d129 1
a129 1
    tk::MenuMotion %W %x %y %s
d133 1
a133 1
    tk::MenuLeave %W %X %Y %s
d136 1
a136 1
    tk::MenuMotion %W %x %y %s
d139 1
a139 1
    tk::MenuButtonDown %W
d142 1
a142 1
   tk::MenuInvoke %W 1
d145 1
a145 1
    tk::MenuInvoke %W 0
d148 1
a148 1
    tk::MenuInvoke %W 0
d151 1
a151 1
    tk::MenuEscape %W
d154 1
a154 1
    tk::MenuLeftArrow %W
d157 1
a157 1
    tk::MenuRightArrow %W
d160 1
a160 1
    tk::MenuUpArrow %W
d163 1
a163 1
    tk::MenuDownArrow %W
d166 1
a166 1
    tk::TraverseWithinMenu %W %A
d174 1
a174 1
	tk::TraverseToMenu %W %A
d178 1
a178 1
	tk::FirstMenu %W
d182 1
a182 1
	tk::TraverseToMenu %W %A
d186 1
a186 1
	tk::FirstMenu %W
d190 1
a190 1
# ::tk::MbEnter --
d194 1
a194 1
# The procedure ::tk::MbB1Enter is invoked if the button is down.
d199 2
a200 2
proc ::tk::MbEnter w {
    variable ::tk::Priv
d202 2
a203 2
    if {[string compare $Priv(inMenubutton) ""]} {
	MbLeave $Priv(inMenubutton)
d205 1
a205 1
    set Priv(inMenubutton) $w
d211 1
a211 1
# ::tk::MbLeave --
d218 2
a219 2
proc ::tk::MbLeave w {
    variable ::tk::Priv
d221 1
a221 1
    set Priv(inMenubutton) {}
d230 1
a230 1
# ::tk::MbPost --
d242 2
a243 3
proc ::tk::MbPost {w {x {}} {y {}}} {
    global errorInfo
    variable ::tk::Priv
d247 1
a247 1
	    [string equal $w $Priv(postedMb)]} {
d259 1
a259 1
    set cur $Priv(postedMb)
d261 1
a261 1
	MenuUnpost {}
d263 2
a264 2
    set Priv(cursor) [$w cget -cursor]
    set Priv(relief) [$w cget -relief]
d268 2
a269 2
    set Priv(postedMb) $w
    set Priv(focus) [focus]
d271 1
a271 1
    GenerateMenuSelect $menu
d293 1
a293 1
    	    	set entry [MenuFindName $menu [$w cget -text]]
d306 1
a306 1
		    GenerateMenuSelect $menu
d312 1
a312 1
    	    	set entry [MenuFindName $menu [$w cget -text]]
d325 1
a325 1
		    GenerateMenuSelect $menu
d334 1
a334 1
	            PostOverPoint $menu $x $y [MenuFindName $menu [$w cget -text]]
d345 1
a345 1
	MenuUnpost {}
d350 1
a350 1
    set Priv(tearoff) $tearoff
d354 1
a354 1
	    SaveGrabInfo $w
d360 1
a360 1
# ::tk::MenuUnpost --
d376 1
a376 1
proc ::tk::MenuUnpost menu {
d378 2
a379 2
    variable ::tk::Priv
    set mb $Priv(postedMb)
d385 2
a386 2
    catch {focus $Priv(focus)}
    set Priv(focus) ""
d395 6
a400 6
	    set Priv(postedMb) {}
	    $mb configure -cursor $Priv(cursor)
	    $mb configure -relief $Priv(relief)
	} elseif {[string compare $Priv(popup) ""]} {
	    $Priv(popup) unpost
	    set Priv(popup) {}
d416 1
a416 1
		GenerateMenuSelect $parent
d430 1
a430 1
    if {($Priv(tearoff) != 0) || [string compare $Priv(menuBar) ""]} {
d439 4
a442 4
	RestoreOldGrab
	if {[string compare $Priv(menuBar) ""]} {
	    $Priv(menuBar) configure -cursor $Priv(cursor)
	    set Priv(menuBar) {}
d445 1
a445 1
	    set Priv(tearoff) 0
d450 1
a450 1
# ::tk::MbMotion --
d461 2
a462 2
proc ::tk::MbMotion {w upDown rootx rooty} {
    variable ::tk::Priv
d464 1
a464 1
    if {[string equal $Priv(inMenubutton) $w]} {
d468 1
a468 1
    if {[string compare $new $Priv(inMenubutton)] \
d471 2
a472 2
	if {[string compare $Priv(inMenubutton) ""]} {
	    MbLeave $Priv(inMenubutton)
d479 1
a479 1
		MbPost $new $rootx $rooty
d481 1
a481 1
		MbEnter $new
d487 1
a487 1
# ::tk::MbButtonUp --
d495 2
a496 2
proc ::tk::MbButtonUp w {
    variable ::tk::Priv
d503 3
a505 3
    if {($tearoff != 0) && [string equal $Priv(postedMb) $w] \
	    && [string equal $Priv(inMenubutton) $w]} {
	MenuFirstEntry [$Priv(postedMb) cget -menu]
d507 1
a507 1
	MenuUnpost {}
d511 1
a511 1
# ::tk::MenuMotion --
d524 3
a526 3
proc ::tk::MenuMotion {menu x y state} {
    variable ::tk::Priv
    if {[string equal $menu $Priv(window)]} {
d528 2
a529 2
	    if {[info exists Priv(focus)] && \
		    [string compare $menu $Priv(focus)]} {
d531 1
a531 1
		GenerateMenuSelect $menu
d535 1
a535 1
	    GenerateMenuSelect $menu
d543 1
a543 1
# ::tk::MenuButtonDown --
d558 2
a559 2
proc ::tk::MenuButtonDown menu {
    variable ::tk::Priv
d566 3
a568 3
    if {[string compare $Priv(postedMb) ""] && \
	    [winfo viewable $Priv(postedMb)]} {
	grab -global $Priv(postedMb)
d576 3
a578 3
	if {[string equal $Priv(menuBar) {}]} {
	    set Priv(menuBar) $menu
	    set Priv(cursor) [$menu cget -cursor]
d588 1
a588 1
	    SaveGrabInfo $menu
d600 1
a600 1
# ::tk::MenuLeave --
d610 3
a612 3
proc ::tk::MenuLeave {menu rootx rooty state} {
    variable ::tk::Priv
    set Priv(window) {}
d622 1
a622 1
    GenerateMenuSelect $menu
d625 1
a625 1
# ::tk::MenuInvoke --
d635 2
a636 2
proc ::tk::MenuInvoke {w buttonRelease} {
    variable ::tk::Priv
d638 1
a638 1
    if {$buttonRelease && [string equal $Priv(window) {}]} {
d646 1
a646 1
	MenuUnpost $w
d652 1
a652 1
	MenuFirstEntry $menu
d654 2
a655 2
	::tk::TearOffMenu $w
	MenuUnpost $w
d670 1
a670 1
	MenuUnpost $w
d680 1
a680 1
	MenuUnpost $w
d685 1
a685 1
# ::tk::MenuEscape --
d693 1
a693 1
proc ::tk::MenuEscape menu {
d696 1
a696 1
	MenuUnpost $menu
d698 2
a699 2
	MenuUnpost $menu
	RestoreOldGrab
d701 1
a701 1
	MenuNextMenu $menu left
d708 1
a708 1
proc ::tk::MenuUpArrow {menu} {
d710 1
a710 1
	MenuNextMenu $menu left
d712 1
a712 1
	MenuNextEntry $menu -1
d716 1
a716 1
proc ::tk::MenuDownArrow {menu} {
d718 1
a718 1
	MenuNextMenu $menu right
d720 1
a720 1
	MenuNextEntry $menu 1
d724 1
a724 1
proc ::tk::MenuLeftArrow {menu} {
d726 1
a726 1
	MenuNextEntry $menu -1
d728 1
a728 1
	MenuNextMenu $menu left
d732 1
a732 1
proc ::tk::MenuRightArrow {menu} {
d734 1
a734 1
	MenuNextEntry $menu 1
d736 1
a736 1
	MenuNextMenu $menu right
d740 1
a740 1
# ::tk::MenuNextMenu --
d750 2
a751 2
proc ::tk::MenuNextMenu {menu direction} {
    variable ::tk::Priv
d763 1
a763 1
		MenuFirstEntry $m2
d772 1
a772 1
		    MenuNextEntry $parent 1
a781 6
	    $menu activate none
	    GenerateMenuSelect $menu
	    tk_menuSetFocus $m2

	    $m2 postcascade none

d783 9
d804 1
a804 1
	    MenuNextEntry $m2 -1
d809 1
a809 1
    set w $Priv(postedMb)
d835 2
a836 2
    MbPost $mb
    MenuFirstEntry [$mb cget -menu]
d839 1
a839 1
# ::tk::MenuNextEntry --
d848 2
a849 1
proc ::tk::MenuNextEntry {menu count} {
d876 1
a876 3
	    if {$state!="disabled" && 
		($i!=0 || [$menu cget -type]!="tearoff" 
			|| [$menu type 0]!="tearoff")} {
d887 2
a888 4
    GenerateMenuSelect $menu

    if {[string equal [$menu type $i] "cascade"] \
	    && [string equal [$menu cget -type] "menubar"]} {
d895 1
a895 1
	    MenuFirstEntry $cascade
d900 1
a900 1
# ::tk::MenuFind --
d916 2
a917 1
proc ::tk::MenuFind {w char} {
d968 1
a968 1
		set match [MenuFind $child $char]
d978 1
a978 1
# ::tk::TraverseToMenu --
d990 2
a991 2
proc ::tk::TraverseToMenu {w char} {
    variable ::tk::Priv
d997 1
a997 1
		&& [string equal $Priv(postedMb) ""]} {
d1005 1
a1005 1
    set w [MenuFind [winfo toplevel $w] $char]
d1009 2
a1010 2
	    set Priv(window) $w
	    SaveGrabInfo $w
d1012 1
a1012 1
	    TraverseWithinMenu $w $char
d1014 2
a1015 2
	    MbPost $w
	    MenuFirstEntry [$w cget -menu]
d1020 1
a1020 1
# ::tk::FirstMenu --
d1028 2
a1029 3
proc ::tk::FirstMenu w {
    variable ::tk::Priv
    set w [MenuFind [winfo toplevel $w] ""]
d1033 2
a1034 2
	    set Priv(window) $w
	    SaveGrabInfo $w
d1036 1
a1036 1
	    MenuFirstEntry $w
d1038 2
a1039 2
	    MbPost $w
	    MenuFirstEntry [$w cget -menu]
d1044 1
a1044 1
# ::tk::TraverseWithinMenu
d1055 1
a1055 1
proc ::tk::TraverseWithinMenu {w char} {
d1076 1
a1076 1
		    MenuFirstEntry $m2
d1079 1
a1079 1
		MenuUnpost $w
d1087 1
a1087 1
# ::tk::MenuFirstEntry --
d1091 1
a1091 1
# because of a previous call to tk::PostOverPoint) then the active
d1098 1
a1098 1
proc ::tk::MenuFirstEntry menu {
d1115 1
a1115 1
	    GenerateMenuSelect $menu
d1125 1
a1125 1
		    MenuFirstEntry $cascade
d1133 1
a1133 1
# ::tk::MenuFindName --
d1144 1
a1144 1
proc ::tk::MenuFindName {menu s} {
d1164 1
a1164 1
# ::tk::PostOverPoint --
d1176 1
a1176 1
proc ::tk::PostOverPoint {menu x y {entry {}}}  {
d1193 1
a1193 1
	GenerateMenuSelect $menu
d1197 2
a1198 2
# ::tk::SaveGrabInfo --
# Sets the variables tk::Priv(oldGrab) and tk::Priv(grabStatus) to record
d1205 5
a1209 5
proc tk::SaveGrabInfo w {
    variable ::tk::Priv
    set Priv(oldGrab) [grab current $w]
    if {[string compare $Priv(oldGrab) ""]} {
	set Priv(grabStatus) [grab status $Priv(oldGrab)]
d1213 1
a1213 1
# ::tk::RestoreOldGrab --
d1217 2
a1218 2
proc ::tk::RestoreOldGrab {} {
    variable ::tk::Priv
d1220 1
a1220 1
    if {[string compare $Priv(oldGrab) ""]} {
d1226 2
a1227 2
          if {[string equal $Priv(grabStatus) "global"]} {
		grab set -global $Priv(oldGrab)
d1229 1
a1229 1
		grab set $Priv(oldGrab)
d1232 1
a1232 1
	set Priv(oldGrab) ""
d1236 4
a1239 4
proc ::tk_menuSetFocus {menu} {
    variable ::tk::Priv
    if {![info exists Priv(focus)] || [string equal $Priv(focus) {}]} {
	set Priv(focus) [focus]
d1244 2
a1245 2
proc ::tk::GenerateMenuSelect {menu} {
    variable ::tk::Priv
d1247 2
a1248 2
    if {[string equal $Priv(activeMenu) $menu] \
          && [string equal $Priv(activeItem) [$menu index active]]} {
d1252 2
a1253 2
    set Priv(activeMenu) $menu
    set Priv(activeItem) [$menu index active]
d1257 1
a1257 1
# ::tk_popup --
d1269 2
a1270 2
proc ::tk_popup {menu x y {entry {}}} {
    variable ::tk::Priv
d1272 3
a1274 3
    if {[string compare $Priv(popup) ""] \
	    || [string compare $Priv(postedMb) ""]} {
	tk::MenuUnpost {}
d1276 1
a1276 1
    tk::PostOverPoint $menu $x $y $entry
d1279 1
a1279 1
        tk::SaveGrabInfo $menu
d1281 1
a1281 1
	set Priv(popup) $menu
@


1.12.6.1
log
@2001-02-28  Don Porter  <dgp@@users.sourceforge.net>

        BRANCH dgp-privates-into-namespace:  Feature branch to move all
        of Tk's private commands and variable into the ::tk namespace
        and its children.

        * doc/tkvars.n:  Documented private variable tkPriv renamed tk::Priv.

        * generic/tkBind.c:
        * generic/tkMenu.c:
        * generic/tkTextDisp.c:
        * library/bgerror.tcl:
        * library/button.tcl:
        * library/choosedir.tcl:
        * library/clrpick.tcl:
        * library/comdlg.tcl:
        * library/console.tcl:
        * library/dialog.tcl:
        * library/entry.tcl:
        * library/focus.tcl:
        * library/listbox.tcl:
        * library/menu.tcl:
        * library/msgbox.tcl:
        * library/optMenu.tcl:
        * library/palette.tcl:
        * library/scale.tcl:
        * library/scrlbar.tcl:
        * library/spinbox.tcl:
        * library/tclIndex:
        * library/tearoff.tcl:
        * library/text.tcl:
        * library/tk.tcl:
        * library/tkfbox.tcl:
        * library/xmfbox.tcl:
        * mac/tkMacMenu.c:
        * tests/clrpick.test:
        * tests/filebox.test:
        * tests/macMenu.test:
        * tests/menu.test:
        * tests/menuDraw.test:
        * tests/msgbox.test:
        * tests/text.test:
        * tests/textDisp.test:
        * tests/unixMenu.test:
        * tests/winMenu.test:
        * tests/xmfbox.test:
        * unix/tkUnixDialog.c:  All Tk commands matching ::tk[A-Z]* and
        all Tk private variables in the global namespace were renamed to
        live in the namespace ::tk or one of its children.
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: menu.tcl,v 1.12 2000/04/17 19:32:00 ericm Exp $
d18 1
a18 1
# Elements of tk::Priv that are used in this file:
d23 2
a24 2
# grabGlobal -		Used in conjunction with tk::Priv(oldGrab):  if
#			tk::Priv(oldGrab) is non-empty, then tk::Priv(grabGlobal)
d65 1
a65 1
#    tk::Priv(postedMb) identifies the posted menubutton.
d67 1
a67 1
#    tk::Priv(postedMb) is empty, and menu's type is "tearoff".
d69 2
a70 2
#    style tk::Priv(postedMb) identifies the posted menubutton.
# 4. As a popup menu.  In this style tk::Priv(postedMb) is empty and
d72 1
a72 1
# 5. As a pulldown from a menubar. The variable tk::Priv(menubar) has
d87 1
a87 1
    tk::MbEnter %W
d90 1
a90 1
    tk::MbLeave %W
d93 2
a94 2
    if {[string compare $tk::Priv(inMenubutton) ""]} {
	tk::MbPost $tk::Priv(inMenubutton) %X %Y
d98 1
a98 1
    tk::MbMotion %W up %X %Y
d101 1
a101 1
    tk::MbMotion %W down %X %Y
d104 1
a104 1
    tk::MbButtonUp %W
d107 2
a108 2
    tk::MbPost %W
    tk::MenuFirstEntry [%W cget -menu]
d121 1
a121 1
    set tk::Priv(window) %W
d129 1
a129 1
    tk::MenuMotion %W %x %y %s
d133 1
a133 1
    tk::MenuLeave %W %X %Y %s
d136 1
a136 1
    tk::MenuMotion %W %x %y %s
d139 1
a139 1
    tk::MenuButtonDown %W
d142 1
a142 1
   tk::MenuInvoke %W 1
d145 1
a145 1
    tk::MenuInvoke %W 0
d148 1
a148 1
    tk::MenuInvoke %W 0
d151 1
a151 1
    tk::MenuEscape %W
d154 1
a154 1
    tk::MenuLeftArrow %W
d157 1
a157 1
    tk::MenuRightArrow %W
d160 1
a160 1
    tk::MenuUpArrow %W
d163 1
a163 1
    tk::MenuDownArrow %W
d166 1
a166 1
    tk::TraverseWithinMenu %W %A
d174 1
a174 1
	tk::TraverseToMenu %W %A
d178 1
a178 1
	tk::FirstMenu %W
d182 1
a182 1
	tk::TraverseToMenu %W %A
d186 1
a186 1
	tk::FirstMenu %W
d190 1
a190 1
# ::tk::MbEnter --
d194 1
a194 1
# The procedure ::tk::MbB1Enter is invoked if the button is down.
d199 2
a200 2
proc ::tk::MbEnter w {
    variable ::tk::Priv
d202 2
a203 2
    if {[string compare $Priv(inMenubutton) ""]} {
	MbLeave $Priv(inMenubutton)
d205 1
a205 1
    set Priv(inMenubutton) $w
d211 1
a211 1
# ::tk::MbLeave --
d218 2
a219 2
proc ::tk::MbLeave w {
    variable ::tk::Priv
d221 1
a221 1
    set Priv(inMenubutton) {}
d230 1
a230 1
# ::tk::MbPost --
d242 2
a243 3
proc ::tk::MbPost {w {x {}} {y {}}} {
    global errorInfo
    variable ::tk::Priv
d247 1
a247 1
	    [string equal $w $Priv(postedMb)]} {
d259 1
a259 1
    set cur $Priv(postedMb)
d261 1
a261 1
	MenuUnpost {}
d263 2
a264 2
    set Priv(cursor) [$w cget -cursor]
    set Priv(relief) [$w cget -relief]
d268 2
a269 2
    set Priv(postedMb) $w
    set Priv(focus) [focus]
d271 1
a271 1
    GenerateMenuSelect $menu
d293 1
a293 1
    	    	set entry [MenuFindName $menu [$w cget -text]]
d306 1
a306 1
		    GenerateMenuSelect $menu
d312 1
a312 1
    	    	set entry [MenuFindName $menu [$w cget -text]]
d325 1
a325 1
		    GenerateMenuSelect $menu
d334 1
a334 1
	            PostOverPoint $menu $x $y [MenuFindName $menu [$w cget -text]]
d345 1
a345 1
	MenuUnpost {}
d350 1
a350 1
    set Priv(tearoff) $tearoff
d354 1
a354 1
	    SaveGrabInfo $w
d360 1
a360 1
# ::tk::MenuUnpost --
d376 1
a376 1
proc ::tk::MenuUnpost menu {
d378 2
a379 2
    variable ::tk::Priv
    set mb $Priv(postedMb)
d385 2
a386 2
    catch {focus $Priv(focus)}
    set Priv(focus) ""
d395 6
a400 6
	    set Priv(postedMb) {}
	    $mb configure -cursor $Priv(cursor)
	    $mb configure -relief $Priv(relief)
	} elseif {[string compare $Priv(popup) ""]} {
	    $Priv(popup) unpost
	    set Priv(popup) {}
d416 1
a416 1
		GenerateMenuSelect $parent
d430 1
a430 1
    if {($Priv(tearoff) != 0) || [string compare $Priv(menuBar) ""]} {
d439 4
a442 4
	RestoreOldGrab
	if {[string compare $Priv(menuBar) ""]} {
	    $Priv(menuBar) configure -cursor $Priv(cursor)
	    set Priv(menuBar) {}
d445 1
a445 1
	    set Priv(tearoff) 0
d450 1
a450 1
# ::tk::MbMotion --
d461 2
a462 2
proc ::tk::MbMotion {w upDown rootx rooty} {
    variable ::tk::Priv
d464 1
a464 1
    if {[string equal $Priv(inMenubutton) $w]} {
d468 1
a468 1
    if {[string compare $new $Priv(inMenubutton)] \
d471 2
a472 2
	if {[string compare $Priv(inMenubutton) ""]} {
	    MbLeave $Priv(inMenubutton)
d479 1
a479 1
		MbPost $new $rootx $rooty
d481 1
a481 1
		MbEnter $new
d487 1
a487 1
# ::tk::MbButtonUp --
d495 2
a496 2
proc ::tk::MbButtonUp w {
    variable ::tk::Priv
d503 3
a505 3
    if {($tearoff != 0) && [string equal $Priv(postedMb) $w] \
	    && [string equal $Priv(inMenubutton) $w]} {
	MenuFirstEntry [$Priv(postedMb) cget -menu]
d507 1
a507 1
	MenuUnpost {}
d511 1
a511 1
# ::tk::MenuMotion --
d524 3
a526 3
proc ::tk::MenuMotion {menu x y state} {
    variable ::tk::Priv
    if {[string equal $menu $Priv(window)]} {
d528 2
a529 2
	    if {[info exists Priv(focus)] && \
		    [string compare $menu $Priv(focus)]} {
d531 1
a531 1
		GenerateMenuSelect $menu
d535 1
a535 1
	    GenerateMenuSelect $menu
d543 1
a543 1
# ::tk::MenuButtonDown --
d558 2
a559 2
proc ::tk::MenuButtonDown menu {
    variable ::tk::Priv
d566 3
a568 3
    if {[string compare $Priv(postedMb) ""] && \
	    [winfo viewable $Priv(postedMb)]} {
	grab -global $Priv(postedMb)
d576 3
a578 3
	if {[string equal $Priv(menuBar) {}]} {
	    set Priv(menuBar) $menu
	    set Priv(cursor) [$menu cget -cursor]
d588 1
a588 1
	    SaveGrabInfo $menu
d600 1
a600 1
# ::tk::MenuLeave --
d610 3
a612 3
proc ::tk::MenuLeave {menu rootx rooty state} {
    variable ::tk::Priv
    set Priv(window) {}
d622 1
a622 1
    GenerateMenuSelect $menu
d625 1
a625 1
# ::tk::MenuInvoke --
d635 2
a636 2
proc ::tk::MenuInvoke {w buttonRelease} {
    variable ::tk::Priv
d638 1
a638 1
    if {$buttonRelease && [string equal $Priv(window) {}]} {
d646 1
a646 1
	MenuUnpost $w
d652 1
a652 1
	MenuFirstEntry $menu
d654 2
a655 2
	::tk::TearOffMenu $w
	MenuUnpost $w
d670 1
a670 1
	MenuUnpost $w
d680 1
a680 1
	MenuUnpost $w
d685 1
a685 1
# ::tk::MenuEscape --
d693 1
a693 1
proc ::tk::MenuEscape menu {
d696 1
a696 1
	MenuUnpost $menu
d698 2
a699 2
	MenuUnpost $menu
	RestoreOldGrab
d701 1
a701 1
	MenuNextMenu $menu left
d708 1
a708 1
proc ::tk::MenuUpArrow {menu} {
d710 1
a710 1
	MenuNextMenu $menu left
d712 1
a712 1
	MenuNextEntry $menu -1
d716 1
a716 1
proc ::tk::MenuDownArrow {menu} {
d718 1
a718 1
	MenuNextMenu $menu right
d720 1
a720 1
	MenuNextEntry $menu 1
d724 1
a724 1
proc ::tk::MenuLeftArrow {menu} {
d726 1
a726 1
	MenuNextEntry $menu -1
d728 1
a728 1
	MenuNextMenu $menu left
d732 1
a732 1
proc ::tk::MenuRightArrow {menu} {
d734 1
a734 1
	MenuNextEntry $menu 1
d736 1
a736 1
	MenuNextMenu $menu right
d740 1
a740 1
# ::tk::MenuNextMenu --
d750 2
a751 2
proc ::tk::MenuNextMenu {menu direction} {
    variable ::tk::Priv
d763 1
a763 1
		MenuFirstEntry $m2
d772 1
a772 1
		    MenuNextEntry $parent 1
d784 1
a784 1
		GenerateMenuSelect $menu
d804 1
a804 1
	    MenuNextEntry $m2 -1
d809 1
a809 1
    set w $Priv(postedMb)
d835 2
a836 2
    MbPost $mb
    MenuFirstEntry [$mb cget -menu]
d839 1
a839 1
# ::tk::MenuNextEntry --
d848 2
a849 1
proc ::tk::MenuNextEntry {menu count} {
d887 1
a887 1
    GenerateMenuSelect $menu
d895 1
a895 1
	    MenuFirstEntry $cascade
d900 1
a900 1
# ::tk::MenuFind --
d916 2
a917 1
proc ::tk::MenuFind {w char} {
d968 1
a968 1
		set match [MenuFind $child $char]
d978 1
a978 1
# ::tk::TraverseToMenu --
d990 2
a991 2
proc ::tk::TraverseToMenu {w char} {
    variable ::tk::Priv
d997 1
a997 1
		&& [string equal $Priv(postedMb) ""]} {
d1005 1
a1005 1
    set w [MenuFind [winfo toplevel $w] $char]
d1009 2
a1010 2
	    set Priv(window) $w
	    SaveGrabInfo $w
d1012 1
a1012 1
	    TraverseWithinMenu $w $char
d1014 2
a1015 2
	    MbPost $w
	    MenuFirstEntry [$w cget -menu]
d1020 1
a1020 1
# ::tk::FirstMenu --
d1028 2
a1029 3
proc ::tk::FirstMenu w {
    variable ::tk::Priv
    set w [MenuFind [winfo toplevel $w] ""]
d1033 2
a1034 2
	    set Priv(window) $w
	    SaveGrabInfo $w
d1036 1
a1036 1
	    MenuFirstEntry $w
d1038 2
a1039 2
	    MbPost $w
	    MenuFirstEntry [$w cget -menu]
d1044 1
a1044 1
# ::tk::TraverseWithinMenu
d1055 1
a1055 1
proc ::tk::TraverseWithinMenu {w char} {
d1076 1
a1076 1
		    MenuFirstEntry $m2
d1079 1
a1079 1
		MenuUnpost $w
d1087 1
a1087 1
# ::tk::MenuFirstEntry --
d1091 1
a1091 1
# because of a previous call to tk::PostOverPoint) then the active
d1098 1
a1098 1
proc ::tk::MenuFirstEntry menu {
d1115 1
a1115 1
	    GenerateMenuSelect $menu
d1125 1
a1125 1
		    MenuFirstEntry $cascade
d1133 1
a1133 1
# ::tk::MenuFindName --
d1144 1
a1144 1
proc ::tk::MenuFindName {menu s} {
d1164 1
a1164 1
# ::tk::PostOverPoint --
d1176 1
a1176 1
proc ::tk::PostOverPoint {menu x y {entry {}}}  {
d1193 1
a1193 1
	GenerateMenuSelect $menu
d1197 2
a1198 2
# ::tk::SaveGrabInfo --
# Sets the variables tk::Priv(oldGrab) and tk::Priv(grabStatus) to record
d1205 5
a1209 5
proc tk::SaveGrabInfo w {
    variable ::tk::Priv
    set Priv(oldGrab) [grab current $w]
    if {[string compare $Priv(oldGrab) ""]} {
	set Priv(grabStatus) [grab status $Priv(oldGrab)]
d1213 1
a1213 1
# ::tk::RestoreOldGrab --
d1217 2
a1218 2
proc ::tk::RestoreOldGrab {} {
    variable ::tk::Priv
d1220 1
a1220 1
    if {[string compare $Priv(oldGrab) ""]} {
d1226 2
a1227 2
          if {[string equal $Priv(grabStatus) "global"]} {
		grab set -global $Priv(oldGrab)
d1229 1
a1229 1
		grab set $Priv(oldGrab)
d1232 1
a1232 1
	set Priv(oldGrab) ""
d1236 4
a1239 4
proc ::tk_menuSetFocus {menu} {
    variable ::tk::Priv
    if {![info exists Priv(focus)] || [string equal $Priv(focus) {}]} {
	set Priv(focus) [focus]
d1244 2
a1245 2
proc ::tk::GenerateMenuSelect {menu} {
    variable ::tk::Priv
d1247 2
a1248 2
    if {[string equal $Priv(activeMenu) $menu] \
          && [string equal $Priv(activeItem) [$menu index active]]} {
d1252 2
a1253 2
    set Priv(activeMenu) $menu
    set Priv(activeItem) [$menu index active]
d1257 1
a1257 1
# ::tk_popup --
d1269 2
a1270 2
proc ::tk_popup {menu x y {entry {}}} {
    variable ::tk::Priv
d1272 3
a1274 3
    if {[string compare $Priv(popup) ""] \
	    || [string compare $Priv(postedMb) ""]} {
	tk::MenuUnpost {}
d1276 1
a1276 1
    tk::PostOverPoint $menu $x $y $entry
d1279 1
a1279 1
        tk::SaveGrabInfo $menu
d1281 1
a1281 1
	set Priv(popup) $menu
@


1.11
log
@	* library/menu.tcl (tkMenuInvoke): corrected naming of tearoffs
	[Bug: 4506]

	* library/tkfbox.tcl (tkIconList_Goto): caused browsecmd to be
	called in tkIconList_Select.  This causes the entry to be set
	properly when using the type-in-name-in-listbox bindings.
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: menu.tcl,v 1.10 2000/03/10 22:16:36 ericm Exp $
d658 12
a669 2
	$w activate none
	event generate $w <<MenuSelect>>
d671 8
@


1.10
log
@* library/menu.tcl: Applied patch from [Bug: 4155]; protects
against grabs on non-viewable windows.
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: menu.tcl,v 1.9 2000/03/07 01:02:26 ericm Exp $
d408 1
a408 1
	    while 1 {
d654 1
a655 1
	tkTearOffMenu $w
d798 1
a798 1
    while 1 {
d844 1
a844 1
    while 1 {
@


1.9
log
@* library/menu.tcl: Added a check in tkMenuFirstEntry that changes
menu behavior to only auto-post an immediate child cascade if we
are currently on a menubar menu.  This prevents massive
auto-cascading in cases where the first entry of the cascade is
itself a cascade, and the first entry of that cascade is a
cascade, and the first entry of that cascade is a cascade
... [Bug: 676].
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: menu.tcl,v 1.8 1999/09/02 17:02:52 hobbs Exp $
d353 4
a356 2
    	tkSaveGrabInfo $w
    	grab -global $w
d566 2
a567 1
    if {[string compare $tkPriv(postedMb) ""]} {
@


1.8
log
@1999-09-01  Jeff Hobbs  <hobbs@@scriptics.com>

	* library/msgbox.tcl: changed the behavior of tk_messageBox on
	Unix to be more Windows like in handling of <Return> and the
	default button
	* library/button.tcl:
	* library/clrpick.tcl:
	* library/comdlg.tcl:
	* library/console.tcl:
	* library/dialog.tcl:
	* library/entry.tcl:
	* library/focus.tcl:
	* library/listbox.tcl:
	* library/menu.tcl:
	* library/msgbox.tcl:
	* library/palette.tcl:
	* library/safetk.tcl:
	* library/scale.tcl:
	* library/scrlbar.tcl:
	* library/tearoff.tcl:
	* library/text.tcl:
	* library/tk.tcl:
	* library/tkfbox.tcl:
	* library/xmfbox.tcl: updated commands to use [string] ops
	instead of expr equality operators
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: menu.tcl,v 1.7 1999/07/22 16:31:48 redman Exp $
d1095 6
a1100 1
	    if {[string equal [$menu type $i] "cascade"]} {
@


1.7
log
@Applied patch from Jeff Hobbs to fix typo in menu.tcl [Bug: 2425]
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: menu.tcl,v 1.6 1999/05/07 20:05:40 stanton Exp $
d122 3
a124 3
    if {![string compare [%W cget -type] "tearoff"]} {
      if {[string compare "%m" "NotifyUngrab"]} {
          if {![string compare $tcl_platform(platform) "unix"]} {
d172 1
a172 1
if {![string compare $tcl_platform(platform) "unix"]} {
d225 1
a225 1
    if {![string compare [$w cget -state] "active"]} {
d246 2
a247 2
    if {![string compare [$w cget -state] "disabled"] ||
      ![string compare $w $tkPriv(postedMb)]} {
d251 1
a251 1
    if {![string compare $menu ""]} {
d254 2
a255 2
    set tearoff [expr {![string compare $tcl_platform(platform) "unix"] \
          || ![string compare [$menu cget -type] "tearoff"]}]
d279 1
a279 1
    	 switch [$w cget -direction] {
d304 1
a304 1
              if {[string compare $entry {}] && [string compare [$menu entrycget $entry -state] "disabled"]} {
d323 1
a323 1
              if {[string compare $entry {}] && [string compare [$menu entrycget $entry -state] "disabled"]} {
d330 1
a330 1
                  if {![string compare $y {}]} {
d339 2
a340 2
    	 }
     } msg]} {
d390 1
a390 1
      if {[string compare $mb ""]} {
d396 1
a396 1
      } elseif {[string compare $tkPriv(popup) ""]} {
d399 2
a400 2
      } elseif {[string compare [$menu cget -type] "menubar"]
              && [string compare [$menu cget -type] "tearoff"]} {
d408 1
a408 1
              if {[string compare [winfo class $parent] "Menu"]
d416 2
a417 2
              if {![string compare $type "menubar"] ||
                  ![string compare $type "tearoff"]} {
d422 1
a422 1
          if {[string compare [$menu cget -type] "menubar"]} {
d431 1
a431 1
      if {[string compare $menu ""]} {
d433 1
a433 1
          if {[string compare $grab ""]} {
d438 1
a438 1
      if {[string compare $tkPriv(menuBar) ""]} {
d442 1
a442 1
      if {[string compare $tcl_platform(platform) "unix"]} {
d462 1
a462 1
    if {![string compare $tkPriv(inMenubutton) $w]} {
d466 4
a469 4
    if {[string compare $new $tkPriv(inMenubutton)]
          && (![string compare $new ""]
          || ![string compare [winfo toplevel $new] [winfo toplevel $w]])} {
      if {[string compare $tkPriv(inMenubutton) ""]} {
d472 3
a474 3
      if {[string compare $new ""]
              && ![string compare [winfo class $new] "Menubutton"]
		&& ([$new cget -indicatoron] == 0)
d476 1
a476 1
          if {![string compare $upDown "down"]} {
d498 5
a502 4
    set tearoff [expr {($tcl_platform(platform) == "unix") \
	    || (($menu != {}) && ([$menu cget -type] == "tearoff"))}]
    if {($tearoff != 0) && ($tkPriv(postedMb) == $w) 
	    && ($tkPriv(inMenubutton) == $w)} {
d524 2
a525 2
    if {![string compare $menu $tkPriv(window)]} {
      if {![string compare [$menu cget -type] "menubar"]} {
d527 1
a527 1
                  [string compare $menu $tkPriv(focus)]} {
d567 2
a568 2
      while {![string compare [$menu cget -type] "normal"]
              && ![string compare [winfo class [winfo parent $menu]] "Menu"]
d573 1
a573 1
      if {![string compare $tkPriv(menuBar) {}]} {
d584 1
a584 1
      if {[string compare $menu [grab current $menu]]} {
d591 1
a591 1
      if {![string compare $tcl_platform(platform) "unix"]} {
d610 1
a610 1
    if {![string compare [$menu index active] "none"]} {
d613 2
a614 2
    if {![string compare [$menu type active] "cascade"]
          && ![string compare [winfo containing $rootx $rooty] \
d635 1
a635 1
    if {$buttonRelease && ![string compare $tkPriv(window) {}]} {
d646 1
a646 1
    if {![string compare [$w type active] "cascade"]} {
d650 1
a650 1
    } elseif {![string compare [$w type active] "tearoff"]} {
d653 1
a653 1
    } elseif {![string compare [$w cget -type] "menubar"]} {
d676 1
a676 1
    } elseif {![string compare [$parent cget -type] "menubar"]} {
d688 1
a688 1
    if {![string compare [$menu cget -type] "menubar"]} {
d696 1
a696 1
    if {![string compare [$menu cget -type] "menubar"]} {
d704 1
a704 1
    if {![string compare [$menu cget -type] "menubar"]} {
d712 1
a712 1
    if {![string compare [$menu cget -type] "menubar"]} {
d734 1
a734 1
    if {![string compare $direction "right"]} {
d738 1
a738 1
      if {![string compare [$menu type active] "cascade"]} {
d741 1
a741 1
          if {[string compare $m2 ""]} {
d747 3
a749 3
          while {[string compare $parent "."]} {
              if {![string compare [winfo class $parent] "Menu"]
                      && ![string compare [$parent cget -type] "menubar"]} {
d760 2
a761 2
      if {![string compare [winfo class $m2] "Menu"]} {
          if {[string compare [$m2 cget -type] "menubar"]} {
d780 2
a781 2
    if {![string compare [winfo class $m2] "Menu"]} {
      if {![string compare [$m2 cget -type] "menubar"]} {
d789 1
a789 1
    if {![string compare $w ""]} {
d803 4
a806 4
      if {![string compare [winfo class $mb] "Menubutton"]
              && [string compare [$mb cget -state] "disabled"]
              && [string compare [$mb cget -menu] ""]
              && [string compare [[$mb cget -menu] index last] "none"]} {
d809 1
a809 1
      if {![string compare $mb $w]} {
d830 1
a830 1
    if {![string compare [$menu index last] "none"]} {
d836 1
a836 1
    if {![string compare $active "none"]} {
d855 1
a855 1
	    if {$state != "disabled"} {
d867 1
a867 1
    if {![string compare [$menu type $i] "cascade"]} {
d869 4
a872 1
      if {[string compare $cascade ""]} {
d902 2
a903 1
        if {[winfo toplevel [focus]] != [winfo toplevel $child] } {
d906 15
a920 4
	switch [winfo class $child] {
	    Menu {
              if {![string compare [$child cget -type] "menubar"]} {
                  if {![string compare $char ""]} {
a922 14
		    set last [$child index last]
		    for {set i [$child cget -tearoff]} {$i <= $last} {incr i} {
                      if {![string compare [$child type $i] "separator"]} {
			    continue
			}
			set char2 [string index [$child entrycget $i -label] \
				[$child entrycget $i -underline]]
                      if {![string compare $char [string tolower $char2]] \
                              || ![string compare $char ""]} {
                          if {[string compare [$child entrycget $i -state] "disabled"]} {
				return $child
			    }
			}
		    }
d930 2
a931 1
        if {[winfo toplevel [focus]] != [winfo toplevel $child] } {
d938 3
a940 3
              if {![string compare $char [string tolower $char2]]
                      || ![string compare $char ""]} {
                  if {[string compare [$child cget -state] "disabled"]} {
d948 1
a948 1
              if {[string compare $match ""]} {
d971 1
a971 1
    if {![string compare $char ""]} {
d974 3
a976 3
    while {![string compare [winfo class $w] "Menu"]} {
      if {[string compare [$w cget -type] "menubar"]
              && ![string compare $tkPriv(postedMb) ""]} {
d979 1
a979 1
      if {![string compare [$w cget -type] "menubar"]} {
d986 1
a986 1
      if {![string compare [winfo class $w] "Menu"]} {
d1010 1
a1010 1
      if {![string compare [winfo class $w] "Menu"]} {
d1035 1
a1035 1
    if {![string compare $char ""]} {
d1040 1
a1040 1
    if {![string compare $last "none"]} {
d1045 1
a1045 2
		[$w entrycget $i -label] \
		[$w entrycget $i -underline]]}]} {
d1048 2
a1049 2
      if {![string compare $char [string tolower $char2]]} {
          if {![string compare [$w type $i] "cascade"]} {
d1054 1
a1054 1
              if {[string compare $m2 ""]} {
d1078 1
a1078 1
    if {![string compare $menu ""]} {
d1086 1
a1086 1
    if {![string compare $last "none"]} {
d1090 3
a1092 3
	if {([catch {set state [$menu entrycget $i -state]}] == 0)
              && [string compare $state "disabled"]
              && [string compare [$menu type $i] "tearoff"]} {
d1095 1
a1095 1
          if {![string compare [$menu type $i] "cascade"]} {
d1097 1
a1097 1
              if {[string compare $cascade ""]} {
d1125 1
a1125 1
    if {![string compare $last "none"]} {
d1130 1
a1130 1
          if {![string compare $label $s]} {
d1164 2
a1165 2
    if {[string compare $entry {}]
          && [string compare [$menu entrycget $entry -state] "disabled"]} {
d1200 1
a1200 1
          if {![string compare $tkPriv(grabStatus) "global"]} {
d1212 1
a1212 1
    if {![info exists tkPriv(focus)] || ![string compare $tkPriv(focus) {}]} {
d1221 2
a1222 2
    if {![string compare $tkPriv(activeMenu) $menu] \
          && ![string compare $tkPriv(activeItem) [$menu index active]]} {
d1246 2
a1247 2
    if {[string compare $tkPriv(popup) ""]
          || [string compare $tkPriv(postedMb) ""]} {
d1251 1
a1251 1
    if {![string compare $tcl_platform(platform) "unix"] \
@


1.6
log
@* library/menu.tcl: Fixed bug where tk_popup fails when called too
quickly. [Bug: 2009]
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: menu.tcl,v 1.5 1999/04/16 01:51:26 stanton Exp $
d937 1
a937 1
                  if {[string compare [$child cget $i -state] "disabled"]} {
@


1.5
log
@* Merged 8.1 branch into the main trunk
@
text
@d7 1
a7 1
# RCS: @@(#) $Id$
d558 4
d1249 3
a1251 2
    if {![string compare $tcl_platform(platform) "unix"]} {
	tkSaveGrabInfo $menu
@


1.4
log
@* library/menu.tcl (tkMenuFind): Changed so keyboard shortcuts
will only be found in the current toplevel.  Previously, they
might be found in menus attached to other toplevels that might not
even be mapped. [Bug: 924]
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: menu.tcl,v 1.3 1998/09/14 18:23:23 stanton Exp $
d11 1
d93 1
a93 1
    if {$tkPriv(inMenubutton) != ""} {
d122 3
a124 3
    if {[%W cget -type] == "tearoff"} {
	if {"%m" != "NotifyUngrab"} {
	    if {$tcl_platform(platform) == "unix"} {
d172 1
a172 1
if {$tcl_platform(platform) == "unix"} {
d202 1
a202 1
    if {$tkPriv(inMenubutton) != ""} {
d206 1
a206 1
    if {[$w cget -state] != "disabled"} {
d225 1
a225 1
    if {[$w cget -state] == "active"} {
d246 2
a247 1
    if {([$w cget -state] == "disabled") || ($w == $tkPriv(postedMb))} {
d251 1
a251 1
    if {$menu == ""} {
d254 2
a255 2
    set tearoff [expr {($tcl_platform(platform) == "unix") \
		     || ([$menu cget -type] == "tearoff")}]
d260 1
a260 1
    if {$cur != ""} {
d304 1
a304 1
    	    	if {($entry != {}) && ([$menu entrycget $entry -state] != "disabled")} {
d323 1
a323 1
    	    	if {($entry != {}) && ([$menu entrycget $entry -state] != "disabled")} {
d330 1
a330 1
	    	    if {$y == ""} {
d390 1
a390 1
	if {$mb != ""} {
d396 1
a396 1
	} elseif {$tkPriv(popup) != ""} {
d399 2
a400 2
	} elseif {(!([$menu cget -type] == "menubar")
		&& !([$menu cget -type] == "tearoff"))} {
d408 1
a408 1
		if {([winfo class $parent] != "Menu")
d416 2
a417 1
		if {($type == "menubar")|| ($type == "tearoff")} {
d422 1
a422 1
	    if {[$menu cget -type] != "menubar"} {
d428 1
a428 1
    if {($tkPriv(tearoff) != 0) || ($tkPriv(menuBar) != "")} {
d431 1
a431 2

	if {$menu != ""} {
d433 1
a433 1
	    if {$grab != ""} {
d438 1
a438 1
	if {$tkPriv(menuBar) != ""} {
d442 1
a442 1
	if {$tcl_platform(platform) != "unix"} {
d462 1
a462 1
    if {$tkPriv(inMenubutton) == $w} {
d466 4
a469 3
    if {($new != $tkPriv(inMenubutton)) && (($new == "")
	    || ([winfo toplevel $new] == [winfo toplevel $w]))} {
	if {$tkPriv(inMenubutton) != ""} {
d472 2
a473 1
	if {($new != "") && ([winfo class $new] == "Menubutton")
d476 1
a476 1
	    if {$upDown == "down"} {
d497 1
d499 1
a499 1
		     || ([[$w cget -menu] cget -type] == "tearoff")}]
d523 2
a524 2
    if {$menu == $tkPriv(window)} {
	if {[$menu cget -type] == "menubar"} {
d526 1
a526 1
		    ([string compare $menu $tkPriv(focus)] != 0)} {
d559 1
a559 1
    if {$tkPriv(postedMb) != ""} {
d562 2
a563 2
	while {([$menu cget -type] == "normal") 
		&& ([winfo class [winfo parent $menu]] == "Menu")
d568 1
a568 1
	if {$tkPriv(menuBar) == {}} {
d579 1
a579 1
	if {$menu != [grab current $menu]} {
d586 1
a586 1
	if {$tcl_platform(platform) == "unix"} {
d605 1
a605 1
    if {[$menu index active] == "none"} {
d608 3
a610 3
    if {([$menu type active] == "cascade")
	    && ([winfo containing $rootx $rooty]
	    == [$menu entrycget active -menu])} {
d630 1
a630 1
    if {$buttonRelease && ($tkPriv(window) == "")} {
d641 1
a641 1
    if {[$w type active] == "cascade"} {
d645 1
a645 1
    } elseif {[$w type active] == "tearoff"} {
d648 1
a648 1
    } elseif {[$w cget -type] == "menubar"} {
d669 1
a669 1
    if {([winfo class $parent] != "Menu")} {
d671 1
a671 1
    } elseif {([$parent cget -type] == "menubar")} {
d683 1
a683 1
    if {[$menu cget -type] == "menubar"} {
d691 1
a691 1
    if {[$menu cget -type] == "menubar"} {
d699 1
a699 1
    if {[$menu cget -type] == "menubar"} {
d707 1
a707 1
    if {[$menu cget -type] == "menubar"} {
d729 1
a729 1
    if {$direction == "right"} {
d733 1
a733 1
	if {[$menu type active] == "cascade"} {
d736 1
a736 1
	    if {$m2 != ""} {
d742 3
a744 3
	    while {($parent != ".")} {
		if {([winfo class $parent] == "Menu")
			&& ([$parent cget -type] == "menubar")} {
d755 2
a756 2
	if {[winfo class $m2] == "Menu"} {
	    if {[$m2 cget -type] != "menubar"} {
d775 2
a776 2
    if {[winfo class $m2] == "Menu"} {
	if {[$m2 cget -type] == "menubar"} {
d784 1
a784 1
    if {$w == ""} {
d798 4
a801 4
	if {([winfo class $mb] == "Menubutton")
		&& ([$mb cget -state] != "disabled")
		&& ([$mb cget -menu] != "")
		&& ([[$mb cget -menu] index last] != "none")} {
d804 1
a804 1
	if {$mb == $w} {
d825 1
a825 1
    if {[$menu index last] == "none"} {
d831 1
a831 1
    if {$active == "none"} {
d862 1
a862 1
    if {[$menu type $i] == "cascade"} {
d864 1
a864 1
	if {[string compare $cascade ""] != 0} {
d899 2
a900 2
		if {[$child cget -type] == "menubar"} {
		    if {$char == ""} {
d905 1
a905 1
			if {[$child type $i] == "separator"} {
d910 3
a912 3
			if {([string compare $char [string tolower $char2]] \
				== 0) || ($char == "")} {
			    if {[$child entrycget $i -state] != "disabled"} {
d931 3
a933 3
		if {([string compare $char [string tolower $char2]] == 0)
			|| ($char == "")} {
		    if {[$child cget -state] != "disabled"} {
d941 1
a941 1
		if {$match != ""} {
d964 1
a964 1
    if {$char == ""} {
d967 3
a969 2
    while {[winfo class $w] == "Menu"} {
	if {([$w cget -type] != "menubar") && ($tkPriv(postedMb) == "")} {
d972 1
a972 1
	if {[$w cget -type] == "menubar"} {
d978 2
a979 2
    if {$w != ""} {
	if {[winfo class $w] == "Menu"} {
d1002 2
a1003 2
    if {$w != ""} {
	if {[winfo class $w] == "Menu"} {
d1028 1
a1028 1
    if {$char == ""} {
d1033 1
a1033 1
    if {$last == "none"} {
d1042 2
a1043 2
	if {[string compare $char [string tolower $char2]] == 0} {
	    if {[$w type $i] == "cascade"} {
d1048 1
a1048 1
		if {$m2 != ""} {
d1072 1
a1072 1
    if {$menu == ""} {
d1076 1
a1076 1
    if {[$menu index active] != "none"} {
d1080 1
a1080 1
    if {$last == "none"} {
d1085 2
a1086 1
		&& ($state != "disabled") && ([$menu type $i] != "tearoff")} {
d1089 1
a1089 1
	    if {[$menu type $i] == "cascade"} {
d1091 1
a1091 1
		if {[string compare $cascade ""] != 0} {
d1119 1
a1119 1
    if {$last == "none"} {
d1124 1
a1124 1
	    if {$label == $s} {
d1147 1
a1147 1
    if {$entry != {}} {
d1158 2
a1159 1
    if {($entry != {}) && ([$menu entrycget $entry -state] != "disabled")} {
d1176 1
a1176 1
    if {$tkPriv(oldGrab) != ""} {
d1188 1
a1188 1
    if {$tkPriv(oldGrab) != ""} {
d1194 1
a1194 1
	    if {$tkPriv(grabStatus) == "global"} {
d1206 1
a1206 1
    if {![info exists tkPriv(focus)] || [string length $tkPriv(focus)] == 0} {
d1215 2
a1216 3
    if {([string compare $tkPriv(activeMenu) $menu] == 0) \
	    && ([string compare $tkPriv(activeItem) [$menu index active]] \
	    == 0)} {
d1240 2
a1241 1
    if {($tkPriv(popup) != "") || ($tkPriv(postedMb) != "")} {
d1245 1
a1245 1
    if {$tcl_platform(platform) == "unix"} {
@


1.3
log
@Replaced SCCS strings, fixed binary files
@
text
@d7 1
a7 1
# RCS: @@(#) $Id$
d888 4
d918 4
@


1.2
log
@plugin updates
@
text
@d7 1
a7 1
# SCCS: @@(#) menu.tcl 1.103 97/10/31 15:26:08
@


1.1
log
@Initial revision
@
text
@d221 1
a221 1
    if ![winfo exists $w] {
d276 1
a276 1
    if [catch {
d280 1
a280 1
    	    	set y [expr [winfo rooty $w] - [winfo reqheight $menu]]
d285 1
a285 1
    	    	set y [expr [winfo rooty $w] + [winfo height $w]]
d289 2
a290 2
    	    	set x [expr [winfo rootx $w] - [winfo reqwidth $menu]]
    	    	set y [expr (2 * [winfo rooty $w] + [winfo height $w]) / 2]
d292 1
a292 1
    	    	if [$w cget -indicatoron] {
d294 2
a295 2
		    	incr y [expr -([$menu yposition $entry] \
			    	+ [winfo reqheight $menu])/2]
d297 2
a298 2
		    	incr y [expr -([$menu yposition $entry] \
			        + [$menu yposition [expr $entry+1]])/2]
d308 2
a309 2
    	    	set x [expr [winfo rootx $w] + [winfo width $w]]
    	    	set y [expr (2 * [winfo rooty $w] + [winfo height $w]) / 2]
d311 1
a311 1
    	    	if [$w cget -indicatoron] {
d313 2
a314 2
		    	incr y [expr -([$menu yposition $entry] \
			    	+ [winfo reqheight $menu])/2]
d316 2
a317 2
		    	incr y [expr -([$menu yposition $entry] \
			        + [$menu yposition [expr $entry+1]])/2]
d327 1
a327 1
    	    	if [$w cget -indicatoron] {
d329 2
a330 2
			set x [expr [winfo rootx $w] + [winfo width $w]/2]
			set y [expr [winfo rooty $w] + [winfo height $w]/2]
d334 1
a334 1
	    	    $menu post [winfo rootx $w] [expr [winfo rooty $w]+[winfo height $w]]
d338 1
a338 1
     } msg] {
d784 1
a784 1
    set i [expr [lsearch -exact $buttons $w] + $count]
d823 1
a823 1
    set length [expr [$menu index last]+1]
d829 1
a829 1
	set i [expr $active + $count]
d1023 1
a1023 1
	if [catch {set char2 [string index \
d1025 1
a1025 1
		[$w entrycget $i -underline]]}] {
d1108 1
a1108 1
	if ![catch {$menu entrycget $i -label} label] {
d1134 2
a1135 2
	    incr y [expr -([$menu yposition $entry] \
		    + [winfo reqheight $menu])/2]
d1137 2
a1138 2
	    incr y [expr -([$menu yposition $entry] \
		    + [$menu yposition [expr $entry+1]])/2]
d1140 1
a1140 1
	incr x [expr -[winfo reqwidth $menu]/2]
@


1.1.4.1
log
@initial tk8.1a2 version
@
text
@d7 1
a7 1
# SCCS: @@(#) menu.tcl 1.104 97/12/03 15:28:59
d221 1
a221 1
    if {![winfo exists $w]} {
d276 1
a276 1
    if {[catch {
d280 1
a280 1
    	    	set y [expr {[winfo rooty $w] - [winfo reqheight $menu]}]
d285 1
a285 1
    	    	set y [expr {[winfo rooty $w] + [winfo height $w]}]
d289 2
a290 2
    	    	set x [expr {[winfo rootx $w] - [winfo reqwidth $menu]}]
    	    	set y [expr {(2 * [winfo rooty $w] + [winfo height $w]) / 2}]
d292 1
a292 1
    	    	if {[$w cget -indicatoron]} {
d294 2
a295 2
		    	incr y [expr {-([$menu yposition $entry] \
			    	+ [winfo reqheight $menu])/2}]
d297 2
a298 2
		    	incr y [expr {-([$menu yposition $entry] \
			        + [$menu yposition [expr {$entry+1}]])/2}]
d308 2
a309 2
    	    	set x [expr {[winfo rootx $w] + [winfo width $w]}]
    	    	set y [expr {(2 * [winfo rooty $w] + [winfo height $w]) / 2}]
d311 1
a311 1
    	    	if {[$w cget -indicatoron]} {
d313 2
a314 2
		    	incr y [expr {-([$menu yposition $entry] \
			    	+ [winfo reqheight $menu])/2}]
d316 2
a317 2
		    	incr y [expr {-([$menu yposition $entry] \
			        + [$menu yposition [expr {$entry+1}]])/2}]
d327 1
a327 1
    	    	if {[$w cget -indicatoron]} {
d329 2
a330 2
			set x [expr {[winfo rootx $w] + [winfo width $w]/2}]
			set y [expr {[winfo rooty $w] + [winfo height $w]/2}]
d334 1
a334 1
	    	    $menu post [winfo rootx $w] [expr {[winfo rooty $w]+[winfo height $w]}]
d338 1
a338 1
     } msg]} {
d784 1
a784 1
    set i [expr {[lsearch -exact $buttons $w] + $count}]
d823 1
a823 1
    set length [expr {[$menu index last]+1}]
d829 1
a829 1
	set i [expr {$active + $count}]
d1023 1
a1023 1
	if {[catch {set char2 [string index \
d1025 1
a1025 1
		[$w entrycget $i -underline]]}]} {
d1108 1
a1108 1
	if {![catch {$menu entrycget $i -label} label]} {
d1134 2
a1135 2
	    incr y [expr {-([$menu yposition $entry] \
		    + [winfo reqheight $menu])/2}]
d1137 2
a1138 2
	    incr y [expr {-([$menu yposition $entry] \
		    + [$menu yposition [expr {$entry+1}]])/2}]
d1140 1
a1140 1
	incr x [expr {-[winfo reqwidth $menu]/2}]
@


1.1.4.2
log
@Merged 8.0.3 changes into 8.1
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: menu.tcl,v 1.3 1998/09/14 18:23:23 stanton Exp $
@


1.1.4.3
log
@* Various cleanup related to the Tcl_Eval and Tcl_ObjSetVar
changes in Tcl.

* Integrated patches from 8.0.5b2
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: menu.tcl,v 1.1.4.2 1998/09/30 02:17:33 stanton Exp $
a10 1
# Copyright (c) 1998-1999 by Scriptics Corporation.
a887 4
	# Don't descend into other toplevels.
        if {[winfo toplevel [focus]] != [winfo toplevel $child] } {
	    continue
	}
a913 4
	# Don't descend into other toplevels.
        if {[winfo toplevel [focus]] != [winfo toplevel $child] } {
	    continue
	}
@


1.1.4.4
log
@fixed bug in menubutton binding that assumed a menu was attached to the button [Bug 1116]
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: menu.tcl,v 1.1.4.3 1999/02/11 04:13:48 stanton Exp $
a493 1
    set menu [$w cget -menu]
d495 1
a495 1
	    || (($menu != {}) && ([ cget -type] == "tearoff"))}]
@


1.1.4.5
log
@fixed bug in menubutton binding that assumed a menu was attached to the button [Bug 1116]
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: menu.tcl,v 1.1.4.4 1999/03/26 19:37:12 surles Exp $
d496 1
a496 1
	    || (($menu != {}) && ([$menu cget -type] == "tearoff"))}]
@


1.1.4.6
log
@* library/bgerror.tcl:
* library/button.tcl:
* library/clrpick.tcl:
* library/console.tcl:
* library/dialog.tcl:
* library/entry.tcl:
* library/focus.tcl:
* library/listbox.tcl:
* library/menu.tcl:
* library/msgbox.tcl:
* library/palette.tcl:
* library/scale.tcl:
* library/scrlbar.tcl:
* library/tearoff.tcl:
* library/text.tcl:
* library/tk.tcl: Lots of minor performance improvements
contributed by Jeffrey Hobbs. [Bug: 1118]
@
text
@d7 1
a7 1
# RCS: @@(#) $Id$
d93 1
a93 1
    if {[string compare $tkPriv(inMenubutton) ""]} {
d122 3
a124 3
    if {![string compare [%W cget -type] "tearoff"]} {
      if {[string compare "%m" "NotifyUngrab"]} {
          if {![string compare $tcl_platform(platform) "unix"]} {
d172 1
a172 1
if {![string compare $tcl_platform(platform) "unix"]} {
d202 1
a202 1
    if {[string compare $tkPriv(inMenubutton) ""]} {
d206 1
a206 1
    if {[string compare [$w cget -state] "disabled"]} {
d225 1
a225 1
    if {![string compare [$w cget -state] "active"]} {
d246 1
a246 2
    if {![string compare [$w cget -state] "disabled"] ||
      ![string compare $w $tkPriv(postedMb)]} {
d250 1
a250 1
    if {![string compare $menu ""]} {
d253 2
a254 2
    set tearoff [expr {![string compare $tcl_platform(platform) "unix"] \
          || ![string compare [$menu cget -type] "tearoff"]}]
d259 1
a259 1
    if {[string compare $cur ""]} {
d303 1
a303 1
              if {[string compare $entry {}] && [string compare [$menu entrycget $entry -state] "disabled"]} {
d322 1
a322 1
              if {[string compare $entry {}] && [string compare [$menu entrycget $entry -state] "disabled"]} {
d329 1
a329 1
                  if {![string compare $y {}]} {
d389 1
a389 1
      if {[string compare $mb ""]} {
d395 1
a395 1
      } elseif {[string compare $tkPriv(popup) ""]} {
d398 2
a399 2
      } elseif {[string compare [$menu cget -type] "menubar"]
              && [string compare [$menu cget -type] "tearoff"]} {
d407 1
a407 1
              if {[string compare [winfo class $parent] "Menu"]
d415 1
a415 2
              if {![string compare $type "menubar"] ||
                  ![string compare $type "tearoff"]} {
d420 1
a420 1
          if {[string compare [$menu cget -type] "menubar"]} {
d426 1
a426 1
    if {($tkPriv(tearoff) != 0) || [string compare $tkPriv(menuBar) ""]} {
d429 2
a430 1
      if {[string compare $menu ""]} {
d432 1
a432 1
          if {[string compare $grab ""]} {
d437 1
a437 1
      if {[string compare $tkPriv(menuBar) ""]} {
d441 1
a441 1
      if {[string compare $tcl_platform(platform) "unix"]} {
d461 1
a461 1
    if {![string compare $tkPriv(inMenubutton) $w]} {
d465 3
a467 4
    if {[string compare $new $tkPriv(inMenubutton)]
          && (![string compare $new ""]
          || ![string compare [winfo toplevel $new] [winfo toplevel $w]])} {
      if {[string compare $tkPriv(inMenubutton) ""]} {
d470 1
a470 2
      if {[string compare $new ""]
              && ![string compare [winfo class $new] "Menubutton"]
d473 1
a473 1
          if {![string compare $upDown "down"]} {
d520 2
a521 2
    if {![string compare $menu $tkPriv(window)]} {
      if {![string compare [$menu cget -type] "menubar"]} {
d523 1
a523 1
                  [string compare $menu $tkPriv(focus)]} {
d556 1
a556 1
    if {[string compare $tkPriv(postedMb) ""]} {
d559 2
a560 2
      while {![string compare [$menu cget -type] "normal"]
              && ![string compare [winfo class [winfo parent $menu]] "Menu"]
d565 1
a565 1
      if {![string compare $tkPriv(menuBar) {}]} {
d576 1
a576 1
      if {[string compare $menu [grab current $menu]]} {
d583 1
a583 1
      if {![string compare $tcl_platform(platform) "unix"]} {
d602 1
a602 1
    if {![string compare [$menu index active] "none"]} {
d605 3
a607 3
    if {![string compare [$menu type active] "cascade"]
          && ![string compare [winfo containing $rootx $rooty] \
                  [$menu entrycget active -menu]]} {
d627 1
a627 1
    if {$buttonRelease && ![string compare $tkPriv(window) {}]} {
d638 1
a638 1
    if {![string compare [$w type active] "cascade"]} {
d642 1
a642 1
    } elseif {![string compare [$w type active] "tearoff"]} {
d645 1
a645 1
    } elseif {![string compare [$w cget -type] "menubar"]} {
d666 1
a666 1
    if {[string compare [winfo class $parent] "Menu"]} {
d668 1
a668 1
    } elseif {![string compare [$parent cget -type] "menubar"]} {
d680 1
a680 1
    if {![string compare [$menu cget -type] "menubar"]} {
d688 1
a688 1
    if {![string compare [$menu cget -type] "menubar"]} {
d696 1
a696 1
    if {![string compare [$menu cget -type] "menubar"]} {
d704 1
a704 1
    if {![string compare [$menu cget -type] "menubar"]} {
d726 1
a726 1
    if {![string compare $direction "right"]} {
d730 1
a730 1
      if {![string compare [$menu type active] "cascade"]} {
d733 1
a733 1
          if {[string compare $m2 ""]} {
d739 3
a741 3
          while {[string compare $parent "."]} {
              if {![string compare [winfo class $parent] "Menu"]
                      && ![string compare [$parent cget -type] "menubar"]} {
d752 2
a753 2
      if {![string compare [winfo class $m2] "Menu"]} {
          if {[string compare [$m2 cget -type] "menubar"]} {
d772 2
a773 2
    if {![string compare [winfo class $m2] "Menu"]} {
      if {![string compare [$m2 cget -type] "menubar"]} {
d781 1
a781 1
    if {![string compare $w ""]} {
d795 4
a798 4
      if {![string compare [winfo class $mb] "Menubutton"]
              && [string compare [$mb cget -state] "disabled"]
              && [string compare [$mb cget -menu] ""]
              && [string compare [[$mb cget -menu] index last] "none"]} {
d801 1
a801 1
      if {![string compare $mb $w]} {
d822 1
a822 1
    if {![string compare [$menu index last] "none"]} {
d828 1
a828 1
    if {![string compare $active "none"]} {
d859 1
a859 1
    if {![string compare [$menu type $i] "cascade"]} {
d861 1
a861 1
      if {[string compare $cascade ""]} {
d896 2
a897 2
              if {![string compare [$child cget -type] "menubar"]} {
                  if {![string compare $char ""]} {
d902 1
a902 1
                      if {![string compare [$child type $i] "separator"]} {
d907 3
a909 3
                      if {![string compare $char [string tolower $char2]] \
                              || ![string compare $char ""]} {
                          if {[string compare [$child entrycget $i -state] "disabled"]} {
d928 3
a930 3
              if {![string compare $char [string tolower $char2]]
                      || ![string compare $char ""]} {
                  if {[string compare [$child cget $i -state] "disabled"]} {
d938 1
a938 1
              if {[string compare $match ""]} {
d961 1
a961 1
    if {![string compare $char ""]} {
d964 2
a965 3
    while {![string compare [winfo class $w] "Menu"]} {
      if {[string compare [$w cget -type] "menubar"]
              && ![string compare $tkPriv(postedMb) ""]} {
d968 1
a968 1
      if {![string compare [$w cget -type] "menubar"]} {
d974 2
a975 2
    if {[string compare $w ""]} {
      if {![string compare [winfo class $w] "Menu"]} {
d998 2
a999 2
    if {[string compare $w ""]} {
      if {![string compare [winfo class $w] "Menu"]} {
d1024 1
a1024 1
    if {![string compare $char ""]} {
d1029 1
a1029 1
    if {![string compare $last "none"]} {
d1038 2
a1039 2
      if {![string compare $char [string tolower $char2]]} {
          if {![string compare [$w type $i] "cascade"]} {
d1044 1
a1044 1
              if {[string compare $m2 ""]} {
d1068 1
a1068 1
    if {![string compare $menu ""]} {
d1072 1
a1072 1
    if {[string compare [$menu index active] "none"]} {
d1076 1
a1076 1
    if {![string compare $last "none"]} {
d1081 1
a1081 2
              && [string compare $state "disabled"]
              && [string compare [$menu type $i] "tearoff"]} {
d1084 1
a1084 1
          if {![string compare [$menu type $i] "cascade"]} {
d1086 1
a1086 1
              if {[string compare $cascade ""]} {
d1114 1
a1114 1
    if {![string compare $last "none"]} {
d1119 1
a1119 1
          if {![string compare $label $s]} {
d1142 1
a1142 1
    if {[string compare $entry {}]} {
d1153 1
a1153 2
    if {[string compare $entry {}]
          && [string compare [$menu entrycget $entry -state] "disabled"]} {
d1170 1
a1170 1
    if {[string compare $tkPriv(oldGrab) ""]} {
d1182 1
a1182 1
    if {[string compare $tkPriv(oldGrab) ""]} {
d1188 1
a1188 1
          if {![string compare $tkPriv(grabStatus) "global"]} {
d1200 1
a1200 1
    if {![info exists tkPriv(focus)] || ![string compare $tkPriv(focus) {}]} {
d1209 3
a1211 2
    if {![string compare $tkPriv(activeMenu) $menu] \
          && ![string compare $tkPriv(activeItem) [$menu index active]]} {
d1235 1
a1235 2
    if {[string compare $tkPriv(popup) ""]
          || [string compare $tkPriv(postedMb) ""]} {
d1239 1
a1239 1
    if {![string compare $tcl_platform(platform) "unix"]} {
@


