summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorpatthoyts <patthoyts@users.sourceforge.net>2010-01-09 00:51:38 (GMT)
committerpatthoyts <patthoyts@users.sourceforge.net>2010-01-09 00:51:38 (GMT)
commit2df4377e0ddaa40ad2acee32cb7e0eccdc486548 (patch)
treec938a08a0a678266d994610d4f840633a47b8297
parent10c0567193f3270ad1b08ba7973106659a100a84 (diff)
downloadtk-2df4377e0ddaa40ad2acee32cb7e0eccdc486548.zip
tk-2df4377e0ddaa40ad2acee32cb7e0eccdc486548.tar.gz
tk-2df4377e0ddaa40ad2acee32cb7e0eccdc486548.tar.bz2
TIP 360: Make Tk menu activation follow mouse movements.
-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 cb7f208..f97127c 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 b304827..bf5c955 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.26.2.5 2009/04/10 16:08:45 das Exp $
+# RCS: @(#) $Id: menu.tcl,v 1.26.2.6 2010/01/09 00:51:38 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..b6cdc53 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.4.2.1 2010/01/09 00:51:38 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"