summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorpatthoyts <patthoyts@users.sourceforge.net>2010-01-09 00:43:46 (GMT)
committerpatthoyts <patthoyts@users.sourceforge.net>2010-01-09 00:43:46 (GMT)
commit7540b82fe0542de05038049569f2b6656338dd18 (patch)
tree96a81adf49e12997f004535ca8375938b5add887
parent2feda836da6d55ba87a093fe45cfe178a6ff1f7e (diff)
downloadtk-7540b82fe0542de05038049569f2b6656338dd18.zip
tk-7540b82fe0542de05038049569f2b6656338dd18.tar.gz
tk-7540b82fe0542de05038049569f2b6656338dd18.tar.bz2
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>
-rw-r--r--ChangeLog5
-rw-r--r--library/menu.tcl25
-rw-r--r--library/obsolete.tcl3
3 files changed, 28 insertions, 5 deletions
diff --git a/ChangeLog b/ChangeLog
index b6f8e97..77c388a 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2010-01-09 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * library/menu.tcl: [TIP 360] Make Tk menu activation
+ * library/obsolete.tcl: follow mouse movements.
+
2010-01-08 Pat Thoyts <patthoyts@users.sourceforge.net>
* doc/photo.n: [Bug 2927569] Multiple edits have peverted the
diff --git a/library/menu.tcl b/library/menu.tcl
index b80af90..751d556 100644
--- a/library/menu.tcl
+++ b/library/menu.tcl
@@ -4,7 +4,7 @@
# It also implements keyboard traversal of menus and implements a few
# other utility procedures related to menus.
#
-# RCS: @(#) $Id: menu.tcl,v 1.32 2009/04/10 16:08:42 das Exp $
+# 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.
@@ -406,6 +406,9 @@ proc ::tk::MenuUnpost menu {
# Unpost menu(s) and restore some stuff that's dependent on
# what was posted.
+ after cancel [array get Priv menuActivatedTimer]
+ unset -nocomplain Priv(menuActivated)
+
catch {
if {$mb ne ""} {
set menu [$mb cget -menu]
@@ -547,6 +550,7 @@ proc ::tk::MbButtonUp w {
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
@@ -556,9 +560,18 @@ proc ::tk::MenuMotion {menu x y state} {
$menu activate @$x,$y
GenerateMenuSelect $menu
}
- }
- if {($state & 0x1f00) != 0} {
- $menu postcascade active
+ 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]]
+ }
+ }
}
}
@@ -600,6 +613,9 @@ proc ::tk::MenuButtonDown menu {
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.
@@ -1311,6 +1327,7 @@ proc ::tk_popup {menu x y {entry {}}} {
tk::SaveGrabInfo $menu
grab -global $menu
set Priv(popup) $menu
+ set Priv(menuActivated) 1
tk_menuSetFocus $menu
}
}
diff --git a/library/obsolete.tcl b/library/obsolete.tcl
index 327fc02..fe19367 100644
--- a/library/obsolete.tcl
+++ b/library/obsolete.tcl
@@ -3,7 +3,7 @@
# This file contains obsolete procedures that people really shouldn't
# be using anymore, but which are kept around for backward compatibility.
#
-# RCS: @(#) $Id: obsolete.tcl,v 1.4 2007/12/13 15:26:27 dgp Exp $
+# RCS: @(#) $Id: obsolete.tcl,v 1.5 2010/01/09 00:43:46 patthoyts Exp $
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
@@ -117,6 +117,7 @@ proc ::tk::classic::restore_menu {args} {
if {[tk windowingsystem] eq "x11"} {
option add *Menu.activeBorderWidth 2 $prio; # 1
option add *Menu.borderWidth 2 $prio; # 1
+ option add *Menu.clickToFocus true $prio
}
if {[tk windowingsystem] ne "aqua"} {
option add *Menu.font "TkDefaultFont" $prio; # "TkMenuFont"