1# 2# $Id$ 3# 4# Utilities for widget implementations. 5# 6 7### Focus management. 8# 9# See also: #1516479 10# 11 12## ttk::takefocus -- 13# This is the default value of the "-takefocus" option 14# for ttk::* widgets that participate in keyboard navigation. 15# 16# NOTES: 17# tk::FocusOK (called by tk_focusNext) tests [winfo viewable] 18# if -takefocus is 1, empty, or missing; but not if it's a 19# script prefix, so we have to check that here as well. 20# 21# 22proc ttk::takefocus {w} { 23 expr {[$w instate !disabled] && [winfo viewable $w]} 24} 25 26## ttk::GuessTakeFocus -- 27# This routine is called as a fallback for widgets 28# with a missing or empty -takefocus option. 29# 30# It implements the same heuristics as tk::FocusOK. 31# 32proc ttk::GuessTakeFocus {w} { 33 # Don't traverse to widgets with '-state disabled': 34 # 35 if {![catch {$w cget -state} state] && $state eq "disabled"} { 36 return 0 37 } 38 39 # Allow traversal to widgets with explicit key or focus bindings: 40 # 41 if {[regexp {Key|Focus} [concat [bind $w] [bind [winfo class $w]]]]} { 42 return 1; 43 } 44 45 # Default is nontraversable: 46 # 47 return 0; 48} 49 50## ttk::traverseTo $w -- 51# Set the keyboard focus to the specified window. 52# 53proc ttk::traverseTo {w} { 54 set focus [focus] 55 if {$focus ne ""} { 56 event generate $focus <<TraverseOut>> 57 } 58 focus $w 59 event generate $w <<TraverseIn>> 60} 61 62## ttk::clickToFocus $w -- 63# Utility routine, used in <ButtonPress-1> bindings -- 64# Assign keyboard focus to the specified widget if -takefocus is enabled. 65# 66proc ttk::clickToFocus {w} { 67 if {[ttk::takesFocus $w]} { focus $w } 68} 69 70## ttk::takesFocus w -- 71# Test if the widget can take keyboard focus. 72# 73# See the description of the -takefocus option in options(n) 74# for details. 75# 76proc ttk::takesFocus {w} { 77 if {![winfo viewable $w]} { 78 return 0 79 } elseif {[catch {$w cget -takefocus} takefocus]} { 80 return [GuessTakeFocus $w] 81 } else { 82 switch -- $takefocus { 83 "" { return [GuessTakeFocus $w] } 84 0 { return 0 } 85 1 { return 1 } 86 default { 87 return [expr {[uplevel #0 $takefocus [list $w]] == 1}] 88 } 89 } 90 } 91} 92 93## ttk::focusFirst $w -- 94# Return the first descendant of $w, in preorder traversal order, 95# that can take keyboard focus, "" if none do. 96# 97# See also: tk_focusNext 98# 99 100proc ttk::focusFirst {w} { 101 if {[ttk::takesFocus $w]} { 102 return $w 103 } 104 foreach child [winfo children $w] { 105 if {[set c [ttk::focusFirst $child]] ne ""} { 106 return $c 107 } 108 } 109 return "" 110} 111 112### Grabs. 113# 114# Rules: 115# Each call to [grabWindow $w] or [globalGrab $w] must be 116# matched with a call to [releaseGrab $w] in LIFO order. 117# 118# Do not call [grabWindow $w] for a window that currently 119# appears on the grab stack. 120# 121# See #1239190 and #1411983 for more discussion. 122# 123namespace eval ttk { 124 variable Grab ;# map: window name -> grab token 125 126 # grab token details: 127 # Two-element list containing: 128 # 1) a script to evaluate to restore the previous grab (if any); 129 # 2) a script to evaluate to restore the focus (if any) 130} 131 132## SaveGrab -- 133# Record current grab and focus windows. 134# 135proc ttk::SaveGrab {w} { 136 variable Grab 137 138 if {[info exists Grab($w)]} { 139 # $w is already on the grab stack. 140 # This should not happen, but bail out in case it does anyway: 141 # 142 return 143 } 144 145 set restoreGrab [set restoreFocus ""] 146 147 set grabbed [grab current $w] 148 if {[winfo exists $grabbed]} { 149 switch [grab status $grabbed] { 150 global { set restoreGrab [list grab -global $grabbed] } 151 local { set restoreGrab [list grab $grabbed] } 152 none { ;# grab window is really in a different interp } 153 } 154 } 155 156 set focus [focus] 157 if {$focus ne ""} { 158 set restoreFocus [list focus -force $focus] 159 } 160 161 set Grab($w) [list $restoreGrab $restoreFocus] 162} 163 164## RestoreGrab -- 165# Restore previous grab and focus windows. 166# If called more than once without an intervening [SaveGrab $w], 167# does nothing. 168# 169proc ttk::RestoreGrab {w} { 170 variable Grab 171 172 if {![info exists Grab($w)]} { # Ignore 173 return; 174 } 175 176 # The previous grab/focus window may have been destroyed, 177 # unmapped, or some other abnormal condition; ignore any errors. 178 # 179 foreach script $Grab($w) { 180 catch $script 181 } 182 183 unset Grab($w) 184} 185 186## ttk::grabWindow $w -- 187# Records the current focus and grab windows, sets an application-modal 188# grab on window $w. 189# 190proc ttk::grabWindow {w} { 191 SaveGrab $w 192 grab $w 193} 194 195## ttk::globalGrab $w -- 196# Same as grabWindow, but sets a global grab on $w. 197# 198proc ttk::globalGrab {w} { 199 SaveGrab $w 200 grab -global $w 201} 202 203## ttk::releaseGrab -- 204# Release the grab previously set by [ttk::grabWindow] 205# or [ttk::globalGrab]. 206# 207proc ttk::releaseGrab {w} { 208 grab release $w 209 RestoreGrab $w 210} 211 212### Auto-repeat. 213# 214# NOTE: repeating widgets do not have -repeatdelay 215# or -repeatinterval resources as in standard Tk; 216# instead a single set of settings is applied application-wide. 217# (TODO: make this user-configurable) 218# 219# (@@@ Windows seems to use something like 500/50 milliseconds 220# @@@ for -repeatdelay/-repeatinterval) 221# 222 223namespace eval ttk { 224 variable Repeat 225 array set Repeat { 226 delay 300 227 interval 100 228 timer {} 229 script {} 230 } 231} 232 233## ttk::Repeatedly -- 234# Begin auto-repeat. 235# 236proc ttk::Repeatedly {args} { 237 variable Repeat 238 after cancel $Repeat(timer) 239 set script [uplevel 1 [list namespace code $args]] 240 set Repeat(script) $script 241 uplevel #0 $script 242 set Repeat(timer) [after $Repeat(delay) ttk::Repeat] 243} 244 245## Repeat -- 246# Continue auto-repeat 247# 248proc ttk::Repeat {} { 249 variable Repeat 250 uplevel #0 $Repeat(script) 251 set Repeat(timer) [after $Repeat(interval) ttk::Repeat] 252} 253 254## ttk::CancelRepeat -- 255# Halt auto-repeat. 256# 257proc ttk::CancelRepeat {} { 258 variable Repeat 259 after cancel $Repeat(timer) 260} 261 262### Bindings. 263# 264 265## ttk::copyBindings $from $to -- 266# Utility routine; copies bindings from one bindtag onto another. 267# 268proc ttk::copyBindings {from to} { 269 foreach event [bind $from] { 270 bind $to $event [bind $from $event] 271 } 272} 273 274### Mousewheel bindings. 275# 276# Platform inconsistencies: 277# 278# On X11, the server typically maps the mouse wheel to Button4 and Button5. 279# 280# On OSX, Tk generates sensible values for the %D field in <MouseWheel> events. 281# 282# On Windows, %D must be scaled by a factor of 120. 283# In addition, Tk redirects mousewheel events to the window with 284# keyboard focus instead of sending them to the window under the pointer. 285# We do not attempt to fix that here, see also TIP#171. 286# 287# OSX conventionally uses Shift+MouseWheel for horizontal scrolling, 288# and Option+MouseWheel for accelerated scrolling. 289# 290# The Shift+MouseWheel behavior is not conventional on Windows or most 291# X11 toolkits, but it's useful. 292# 293# MouseWheel scrolling is accelerated on X11, which is conventional 294# for Tk and appears to be conventional for other toolkits (although 295# Gtk+ and Qt do not appear to use as large a factor). 296# 297 298## ttk::bindMouseWheel $bindtag $command... 299# Adds basic mousewheel support to $bindtag. 300# $command will be passed one additional argument 301# specifying the mousewheel direction (-1: up, +1: down). 302# 303 304proc ttk::bindMouseWheel {bindtag callback} { 305 switch -- [tk windowingsystem] { 306 x11 { 307 bind $bindtag <ButtonPress-4> "$callback -1" 308 bind $bindtag <ButtonPress-5> "$callback +1" 309 } 310 win32 { 311 bind $bindtag <MouseWheel> [append callback { [expr {-(%D/120)}]}] 312 } 313 aqua { 314 bind $bindtag <MouseWheel> [append callback { [expr {-(%D)}]} ] 315 } 316 } 317} 318 319## Mousewheel bindings for standard scrollable widgets. 320# 321# Usage: [ttk::copyBindings TtkScrollable $bindtag] 322# 323# $bindtag should be for a widget that supports the 324# standard scrollbar protocol. 325# 326 327switch -- [tk windowingsystem] { 328 x11 { 329 bind TtkScrollable <ButtonPress-4> { %W yview scroll -5 units } 330 bind TtkScrollable <ButtonPress-5> { %W yview scroll 5 units } 331 bind TtkScrollable <Shift-ButtonPress-4> { %W xview scroll -5 units } 332 bind TtkScrollable <Shift-ButtonPress-5> { %W xview scroll 5 units } 333 } 334 win32 { 335 bind TtkScrollable <MouseWheel> \ 336 { %W yview scroll [expr {-(%D/120)}] units } 337 bind TtkScrollable <Shift-MouseWheel> \ 338 { %W xview scroll [expr {-(%D/120)}] units } 339 } 340 aqua { 341 bind TtkScrollable <MouseWheel> \ 342 { %W yview scroll [expr {-(%D)}] units } 343 bind TtkScrollable <Shift-MouseWheel> \ 344 { %W xview scroll [expr {-(%D)}] units } 345 bind TtkScrollable <Option-MouseWheel> \ 346 { %W yview scroll [expr {-10*(%D)}] units } 347 bind TtkScrollable <Shift-Option-MouseWheel> \ 348 { %W xview scroll [expr {-10*(%D)}] units } 349 } 350} 351 352#*EOF* 353