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