2 # Utilities for widget implementations.
11 # This is the default value of the "-takefocus" option
12 # for ttk::* widgets that participate in keyboard navigation.
15 # tk::FocusOK (called by tk_focusNext) tests [winfo viewable]
16 # if -takefocus is 1, empty, or missing; but not if it's a
17 # script prefix, so we have to check that here as well.
20 proc ttk
::takefocus {w
} {
21 expr {[$w instate
!disabled
] && [winfo viewable
$w]}
24 ## ttk::GuessTakeFocus --
25 # This routine is called as a fallback for widgets
26 # with a missing or empty -takefocus option.
28 # It implements the same heuristics as tk::FocusOK.
30 proc ttk
::GuessTakeFocus {w
} {
31 # Don't traverse to widgets with '-state disabled':
33 if {![catch {$w cget
-state} state
] && $state eq
"disabled"} {
37 # Allow traversal to widgets with explicit key or focus bindings:
39 if {[regexp {Key|Focus
} [concat [bind $w] [bind [winfo class
$w]]]]} {
43 # Default is nontraversable:
48 ## ttk::traverseTo $w --
49 # Set the keyboard focus to the specified window.
51 proc ttk
::traverseTo {w
} {
54 event generate
$focus <<TraverseOut
>>
57 event generate
$w <<TraverseIn
>>
60 ## ttk::clickToFocus $w --
61 # Utility routine, used in <ButtonPress-1> bindings --
62 # Assign keyboard focus to the specified widget if -takefocus is enabled.
64 proc ttk
::clickToFocus {w
} {
65 if {[ttk
::takesFocus $w]} { focus $w }
68 ## ttk::takesFocus w --
69 # Test if the widget can take keyboard focus.
71 # See the description of the -takefocus option in options(n)
74 proc ttk
::takesFocus {w
} {
75 if {![winfo viewable
$w]} {
77 } elseif
{[catch {$w cget
-takefocus} takefocus
]} {
78 return [GuessTakeFocus
$w]
80 switch -- $takefocus {
81 "" { return [GuessTakeFocus
$w] }
85 return [expr {[uplevel #0 $takefocus [list $w]] == 1}]
91 ## ttk::focusFirst $w --
92 # Return the first descendant of $w, in preorder traversal order,
93 # that can take keyboard focus, "" if none do.
95 # See also: tk_focusNext
98 proc ttk
::focusFirst {w
} {
99 if {[ttk
::takesFocus $w]} {
102 foreach child
[winfo children
$w] {
103 if {[set c
[ttk
::focusFirst $child]] ne
""} {
113 # Each call to [grabWindow $w] or [globalGrab $w] must be
114 # matched with a call to [releaseGrab $w] in LIFO order.
116 # Do not call [grabWindow $w] for a window that currently
117 # appears on the grab stack.
119 # See #1239190 and #1411983 for more discussion.
122 variable Grab
;# map: window name -> grab token
124 # grab token details:
125 # Two-element list containing:
126 # 1) a script to evaluate to restore the previous grab (if any);
127 # 2) a script to evaluate to restore the focus (if any)
131 # Record current grab and focus windows.
133 proc ttk
::SaveGrab {w
} {
136 if {[info exists Grab
($w)]} {
137 # $w is already on the grab stack.
138 # This should not happen, but bail out in case it does anyway:
143 set restoreGrab
[set restoreFocus
""]
145 set grabbed
[grab current
$w]
146 if {[winfo exists
$grabbed]} {
147 switch [grab status
$grabbed] {
148 global { set restoreGrab
[list grab -global $grabbed] }
149 local
{ set restoreGrab
[list grab $grabbed] }
150 none
{ ;# grab window is really in a different interp }
156 set restoreFocus
[list focus -force $focus]
159 set Grab
($w) [list $restoreGrab $restoreFocus]
163 # Restore previous grab and focus windows.
164 # If called more than once without an intervening [SaveGrab $w],
167 proc ttk
::RestoreGrab {w
} {
170 if {![info exists Grab
($w)]} { # Ignore
174 # The previous grab/focus window may have been destroyed,
175 # unmapped, or some other abnormal condition; ignore any errors.
177 foreach script
$Grab($w) {
184 ## ttk::grabWindow $w --
185 # Records the current focus and grab windows, sets an application-modal
188 proc ttk
::grabWindow {w
} {
193 ## ttk::globalGrab $w --
194 # Same as grabWindow, but sets a global grab on $w.
196 proc ttk
::globalGrab {w
} {
201 ## ttk::releaseGrab --
202 # Release the grab previously set by [ttk::grabWindow]
203 # or [ttk::globalGrab].
205 proc ttk
::releaseGrab {w
} {
212 # NOTE: repeating widgets do not have -repeatdelay
213 # or -repeatinterval resources as in standard Tk;
214 # instead a single set of settings is applied application-wide.
215 # (TODO: make this user-configurable)
217 # (@@@ Windows seems to use something like 500/50 milliseconds
218 # @@@ for -repeatdelay/-repeatinterval)
231 ## ttk::Repeatedly --
234 proc ttk
::Repeatedly {args
} {
236 after cancel
$Repeat(timer
)
237 set script
[uplevel 1 [list namespace code
$args]]
238 set Repeat
(script
) $script
240 set Repeat
(timer
) [after $Repeat(delay
) ttk
::Repeat]
244 # Continue auto-repeat
246 proc ttk
::Repeat {} {
248 uplevel #0 $Repeat(script)
249 set Repeat
(timer
) [after $Repeat(interval
) ttk
::Repeat]
252 ## ttk::CancelRepeat --
255 proc ttk
::CancelRepeat {} {
257 after cancel
$Repeat(timer
)
263 ## ttk::copyBindings $from $to --
264 # Utility routine; copies bindings from one bindtag onto another.
266 proc ttk
::copyBindings {from to
} {
267 foreach event [bind $from] {
268 bind $to $event [bind $from $event]
272 ### Mousewheel bindings.
274 # Platform inconsistencies:
276 # On X11, the server typically maps the mouse wheel to Button4 and Button5.
278 # On OSX, Tk generates sensible values for the %D field in <MouseWheel> events.
280 # On Windows, %D must be scaled by a factor of 120.
281 # In addition, Tk redirects mousewheel events to the window with
282 # keyboard focus instead of sending them to the window under the pointer.
283 # We do not attempt to fix that here, see also TIP#171.
285 # OSX conventionally uses Shift+MouseWheel for horizontal scrolling,
286 # and Option+MouseWheel for accelerated scrolling.
288 # The Shift+MouseWheel behavior is not conventional on Windows or most
289 # X11 toolkits, but it's useful.
291 # MouseWheel scrolling is accelerated on X11, which is conventional
292 # for Tk and appears to be conventional for other toolkits (although
293 # Gtk+ and Qt do not appear to use as large a factor).
296 ## ttk::bindMouseWheel $bindtag $command...
297 # Adds basic mousewheel support to $bindtag.
298 # $command will be passed one additional argument
299 # specifying the mousewheel direction (-1: up, +1: down).
302 proc ttk
::bindMouseWheel {bindtag callback
} {
303 switch -- [tk windowingsystem
] {
305 bind $bindtag <ButtonPress-4
> "$callback -1"
306 bind $bindtag <ButtonPress-5
> "$callback +1"
309 bind $bindtag <MouseWheel
> [append callback
{ [expr {-(%D
/120)}]}]
312 bind $bindtag <MouseWheel
> [append callback
{ [expr {-(%D
)}]} ]
317 ## Mousewheel bindings for standard scrollable widgets.
319 # Usage: [ttk::copyBindings TtkScrollable $bindtag]
321 # $bindtag should be for a widget that supports the
322 # standard scrollbar protocol.
325 switch -- [tk windowingsystem
] {
327 bind TtkScrollable
<ButtonPress-4
> { %W yview scroll
-5 units
}
328 bind TtkScrollable
<ButtonPress-5
> { %W yview scroll
5 units
}
329 bind TtkScrollable
<Shift-ButtonPress-4
> { %W xview scroll
-5 units
}
330 bind TtkScrollable
<Shift-ButtonPress-5
> { %W xview scroll
5 units
}
333 bind TtkScrollable
<MouseWheel
> \
334 { %W yview scroll
[expr {-(%D
/120)}] units
}
335 bind TtkScrollable
<Shift-MouseWheel
> \
336 { %W xview scroll
[expr {-(%D
/120)}] units
}
339 bind TtkScrollable
<MouseWheel
> \
340 { %W yview scroll
[expr {-(%D
)}] units
}
341 bind TtkScrollable
<Shift-MouseWheel
> \
342 { %W xview scroll
[expr {-(%D
)}] units
}
343 bind TtkScrollable
<Option-MouseWheel
> \
344 { %W yview scroll
[expr {-10*(%D
)}] units
}
345 bind TtkScrollable
<Shift-Option-MouseWheel
> \
346 { %W xview scroll
[expr {-10*(%D
)}] units
}