menubutton.tcl (4913B)
1 # 2 # Bindings for Menubuttons. 3 # 4 # Menubuttons have three interaction modes: 5 # 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 9 # 10 # (In addition, when menu system is active, "dropdown" -- menu posts 11 # on mouse-over. Ttk menubuttons don't implement this). 12 # 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. 15 # 16 # ON X11: 17 # 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. 25 # 26 # ON WINDOWS: 27 # 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. 31 # 32 # ON MACOS: 33 # 34 # Same probably applies here. 35 # 36 37 namespace eval ttk { 38 namespace eval menubutton { 39 variable State 40 array set State { 41 pulldown 0 42 oldcursor {} 43 } 44 } 45 } 46 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 } 51 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 } 56 } else { 57 bind TMenubutton <ButtonPress-1> \ 58 { %W state pressed ; ttk::menubutton::Popdown %W } 59 bind TMenubutton <ButtonRelease-1> \ 60 { if {[winfo exists %W]} { %W state !pressed } } 61 } 62 63 # PostPosition -- 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. 67 # 68 # TODO: adjust menu width to be at least as wide as the button 69 # for -direction above, below. 70 # 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] 75 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}] 82 83 switch -- $dir { 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 } } 88 flush { 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]] 94 if {$index ne ""} { 95 incr y -[$menu yposition $index] 96 } 97 } 98 } 99 100 return [list $x $y] 101 } 102 103 # Popdown -- 104 # Post the menu and set a grab on the menu. 105 # 106 proc ttk::menubutton::Popdown {mb} { 107 if {[$mb instate disabled] || [set menu [$mb cget -menu]] eq ""} { 108 return 109 } 110 foreach {x y} [PostPosition $mb $menu] { break } 111 tk_popup $menu $x $y 112 } 113 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. 118 # 119 proc ttk::menubutton::Pulldown {mb} { 120 variable State 121 if {[$mb instate disabled] || [set menu [$mb cget -menu]] eq ""} { 122 return 123 } 124 foreach {x y} [PostPosition $mb $menu] { break } 125 set State(pulldown) 1 126 set State(oldcursor) [$mb cget -cursor] 127 128 $mb state pressed 129 $mb configure -cursor [$menu cget -cursor] 130 $menu post $x $y 131 tk_menuSetFocus $menu 132 } 133 134 # TransferGrab (X11 only) -- 135 # Switch from pulldown mode (menubutton has an implicit grab) 136 # to popdown mode (menu has an explicit grab). 137 # 138 proc ttk::menubutton::TransferGrab {mb} { 139 variable State 140 if {$State(pulldown)} { 141 $mb configure -cursor $State(oldcursor) 142 $mb state {!pressed !active} 143 set State(pulldown) 0 144 145 set menu [$mb cget -menu] 146 tk_popup $menu [winfo rootx $menu] [winfo rooty $menu] 147 } 148 } 149 150 # FindMenuEntry -- 151 # Hack to support tk_optionMenus. 152 # Returns the index of the menu entry with a matching -label, 153 # -1 if not found. 154 # 155 proc ttk::menubutton::FindMenuEntry {menu s} { 156 set last [$menu index last] 157 if {$last eq "none"} { 158 return "" 159 } 160 for {set i 0} {$i <= $last} {incr i} { 161 if {![catch {$menu entrycget $i -label} label] 162 && ($label eq $s)} { 163 return $i 164 } 165 } 166 return "" 167 } 168 169 #*EOF*