diff options
| author | patthoyts <patthoyts@users.sourceforge.net> | 2010-01-09 00:43:46 (GMT) |
|---|---|---|
| committer | patthoyts <patthoyts@users.sourceforge.net> | 2010-01-09 00:43:46 (GMT) |
| commit | 7540b82fe0542de05038049569f2b6656338dd18 (patch) | |
| tree | 96a81adf49e12997f004535ca8375938b5add887 | |
| parent | 2feda836da6d55ba87a093fe45cfe178a6ff1f7e (diff) | |
| download | tk-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-- | ChangeLog | 5 | ||||
| -rw-r--r-- | library/menu.tcl | 25 | ||||
| -rw-r--r-- | library/obsolete.tcl | 3 |
3 files changed, 28 insertions, 5 deletions
@@ -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" |