2 # Bindings for Menubuttons.
4 # Menubuttons have three interaction modes:
6 # Pulldown: Press menubutton, drag over menu, release to activate menu entry
7 # Popdown: Click menubutton to post menu
8 # Keyboard: <Key-space> or accelerator key to post menu
10 # (In addition, when menu system is active, "dropdown" -- menu posts
11 # on mouse-over. Ttk menubuttons don't implement this).
13 # For keyboard and popdown mode, we hand off to tk_popup and let
14 # the built-in Tk bindings handle the rest of the interaction.
18 # Standard Tk menubuttons use a global grab on the menubutton.
19 # This won't work for Ttk menubuttons in pulldown mode,
20 # since we need to process the final <ButtonRelease> event,
21 # and this might be delivered to the menu. So instead we
22 # rely on the passive grab that occurs on <ButtonPress> events,
23 # and transition to popdown mode when the mouse is released
24 # or dragged outside the menubutton.
28 # I'm not sure what the hell is going on here. [$menu post] apparently
29 # sets up some kind of internal grab for native menus.
30 # On this platform, just use [tk_popup] for all menu actions.
34 # Same probably applies here.
38 namespace eval menubutton {
47 bind TMenubutton
<Enter
> { %W instate
!disabled
{%W state active
} }
48 bind TMenubutton
<Leave
> { %W state
!active
}
49 bind TMenubutton
<Key-space
> { ttk
::menubutton::Popdown %W
}
50 bind TMenubutton
<<Invoke
>> { ttk
::menubutton::Popdown %W
}
52 if {[tk windowingsystem
] eq
"x11"} {
53 bind TMenubutton
<ButtonPress-1
> { ttk
::menubutton::Pulldown %W
}
54 bind TMenubutton
<ButtonRelease-1
> { ttk
::menubutton::TransferGrab %W
}
55 bind TMenubutton
<B1-Leave
> { ttk
::menubutton::TransferGrab %W
}
57 bind TMenubutton
<ButtonPress-1
> \
58 { %W state pressed
; ttk
::menubutton::Popdown %W
}
59 bind TMenubutton
<ButtonRelease-1
> \
64 # Returns the x and y coordinates where the menu
65 # should be posted, based on the menubutton and menu size
66 # and -direction option.
68 # TODO: adjust menu width to be at least as wide as the button
69 # for -direction above, below.
71 proc ttk
::menubutton::PostPosition {mb
menu} {
72 set x
[winfo rootx
$mb]
73 set y
[winfo rooty
$mb]
74 set dir
[$mb cget
-direction]
76 set bw
[winfo width
$mb]
77 set bh
[winfo height
$mb]
78 set mw
[winfo reqwidth
$menu]
79 set mh
[winfo reqheight
$menu]
80 set sw
[expr {[winfo screenwidth
$menu] - $bw - $mw}]
81 set sh
[expr {[winfo screenheight
$menu] - $bh - $mh}]
84 above
{ if {$y >= $mh} { incr y
-$mh } { incr y
$bh } }
85 below
{ if {$y <= $sh} { incr y
$bh } { incr y
-$mh } }
86 left
{ if {$x >= $mw} { incr x
-$mw } { incr x
$bw } }
87 right
{ if {$x <= $sw} { incr x
$bw } { incr x
-$mw } }
89 # post menu atop menubutton.
90 # If there's a menu entry whose label matches the
91 # menubutton -text, assume this is an optionmenu
92 # and place that entry over the menubutton.
93 set index
[FindMenuEntry
$menu [$mb cget
-text]]
95 incr y
-[$menu yposition
$index]
104 # Post the menu and set a grab on the menu.
106 proc ttk
::menubutton::Popdown {mb
} {
107 if {[$mb instate disabled
] ||
[set menu [$mb cget
-menu]] eq
""} {
110 foreach {x y
} [PostPosition
$mb $menu] { break }
114 # Pulldown (X11 only) --
115 # Called when Button1 is pressed on a menubutton.
116 # Posts the menu; a subsequent ButtonRelease
117 # or Leave event will set a grab on the menu.
119 proc ttk
::menubutton::Pulldown {mb
} {
121 if {[$mb instate disabled
] ||
[set menu [$mb cget
-menu]] eq
""} {
124 foreach {x y
} [PostPosition
$mb $menu] { break }
125 set State
(pulldown
) 1
126 set State
(oldcursor
) [$mb cget
-cursor]
129 $mb configure
-cursor [$menu cget
-cursor]
131 tk_menuSetFocus $menu
134 # TransferGrab (X11 only) --
135 # Switch from pulldown mode (menubutton has an implicit grab)
136 # to popdown mode (menu has an explicit grab).
138 proc ttk
::menubutton::TransferGrab {mb
} {
140 if {$State(pulldown
)} {
141 $mb configure
-cursor $State(oldcursor
)
142 $mb state
{!pressed
!active
}
143 set State
(pulldown
) 0
145 set menu [$mb cget
-menu]
146 tk_popup $menu [winfo rootx
$menu] [winfo rooty
$menu]
151 # Hack to support tk_optionMenus.
152 # Returns the index of the menu entry with a matching -label,
155 proc ttk
::menubutton::FindMenuEntry {menu s
} {
156 set last
[$menu index last
]
157 if {$last eq
"none"} {
160 for {set i
0} {$i <= $last} {incr i
} {
161 if {![catch {$menu entrycget
$i -label} label]