Tk Source Code

Artifact [0e1b03d9]
Login

Artifact 0e1b03d9a54dbb79e7659d7cb064bb342af1212f:

Attachment "0001-unix-menus-Make-Tk-menu-activation-follow-mouse-move.patch" to ticket [2920409f] added by patthoyts 2010-01-03 05:12:34.
From 339927a62408ebae354eae9cb0790677a094d707 Mon Sep 17 00:00:00 2001
From: Pat Thoyts <[email protected]>
Date: Wed, 23 Dec 2009 23:38:36 +0000
Subject: [PATCH 1/3] unix-menus: 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 <[email protected]>
---
 library/menu.tcl     |   23 ++++++++++++++++++++---
 library/obsolete.tcl |    1 +
 2 files changed, 21 insertions(+), 3 deletions(-)

diff --git a/library/menu.tcl b/library/menu.tcl
index a2d9109..cbdbbcf 100644
--- a/library/menu.tcl
+++ b/library/menu.tcl
@@ -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 98d181e..a7aef8c 100644
--- a/library/obsolete.tcl
+++ b/library/obsolete.tcl
@@ -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"
-- 
1.6.6