Commit | Line | Data |
---|---|---|
920dae64 AT |
1 | # focus.tcl -- |
2 | # | |
3 | # This file defines several procedures for managing the input | |
4 | # focus. | |
5 | # | |
6 | # RCS: @(#) $Id: focus.tcl,v 1.9 2001/08/01 16:21:11 dgp Exp $ | |
7 | # | |
8 | # Copyright (c) 1994-1995 Sun Microsystems, Inc. | |
9 | # | |
10 | # See the file "license.terms" for information on usage and redistribution | |
11 | # of this file, and for a DISCLAIMER OF ALL WARRANTIES. | |
12 | # | |
13 | ||
14 | # ::tk_focusNext -- | |
15 | # This procedure returns the name of the next window after "w" in | |
16 | # "focus order" (the window that should receive the focus next if | |
17 | # Tab is typed in w). "Next" is defined by a pre-order search | |
18 | # of a top-level and its non-top-level descendants, with the stacking | |
19 | # order determining the order of siblings. The "-takefocus" options | |
20 | # on windows determine whether or not they should be skipped. | |
21 | # | |
22 | # Arguments: | |
23 | # w - Name of a window. | |
24 | ||
25 | proc ::tk_focusNext w { | |
26 | set cur $w | |
27 | while {1} { | |
28 | ||
29 | # Descend to just before the first child of the current widget. | |
30 | ||
31 | set parent $cur | |
32 | set children [winfo children $cur] | |
33 | set i -1 | |
34 | ||
35 | # Look for the next sibling that isn't a top-level. | |
36 | ||
37 | while {1} { | |
38 | incr i | |
39 | if {$i < [llength $children]} { | |
40 | set cur [lindex $children $i] | |
41 | if {[string equal [winfo toplevel $cur] $cur]} { | |
42 | continue | |
43 | } else { | |
44 | break | |
45 | } | |
46 | } | |
47 | ||
48 | # No more siblings, so go to the current widget's parent. | |
49 | # If it's a top-level, break out of the loop, otherwise | |
50 | # look for its next sibling. | |
51 | ||
52 | set cur $parent | |
53 | if {[string equal [winfo toplevel $cur] $cur]} { | |
54 | break | |
55 | } | |
56 | set parent [winfo parent $parent] | |
57 | set children [winfo children $parent] | |
58 | set i [lsearch -exact $children $cur] | |
59 | } | |
60 | if {[string equal $w $cur] || [tk::FocusOK $cur]} { | |
61 | return $cur | |
62 | } | |
63 | } | |
64 | } | |
65 | ||
66 | # ::tk_focusPrev -- | |
67 | # This procedure returns the name of the previous window before "w" in | |
68 | # "focus order" (the window that should receive the focus next if | |
69 | # Shift-Tab is typed in w). "Next" is defined by a pre-order search | |
70 | # of a top-level and its non-top-level descendants, with the stacking | |
71 | # order determining the order of siblings. The "-takefocus" options | |
72 | # on windows determine whether or not they should be skipped. | |
73 | # | |
74 | # Arguments: | |
75 | # w - Name of a window. | |
76 | ||
77 | proc ::tk_focusPrev w { | |
78 | set cur $w | |
79 | while {1} { | |
80 | ||
81 | # Collect information about the current window's position | |
82 | # among its siblings. Also, if the window is a top-level, | |
83 | # then reposition to just after the last child of the window. | |
84 | ||
85 | if {[string equal [winfo toplevel $cur] $cur]} { | |
86 | set parent $cur | |
87 | set children [winfo children $cur] | |
88 | set i [llength $children] | |
89 | } else { | |
90 | set parent [winfo parent $cur] | |
91 | set children [winfo children $parent] | |
92 | set i [lsearch -exact $children $cur] | |
93 | } | |
94 | ||
95 | # Go to the previous sibling, then descend to its last descendant | |
96 | # (highest in stacking order. While doing this, ignore top-levels | |
97 | # and their descendants. When we run out of descendants, go up | |
98 | # one level to the parent. | |
99 | ||
100 | while {$i > 0} { | |
101 | incr i -1 | |
102 | set cur [lindex $children $i] | |
103 | if {[string equal [winfo toplevel $cur] $cur]} { | |
104 | continue | |
105 | } | |
106 | set parent $cur | |
107 | set children [winfo children $parent] | |
108 | set i [llength $children] | |
109 | } | |
110 | set cur $parent | |
111 | if {[string equal $w $cur] || [tk::FocusOK $cur]} { | |
112 | return $cur | |
113 | } | |
114 | } | |
115 | } | |
116 | ||
117 | # ::tk::FocusOK -- | |
118 | # | |
119 | # This procedure is invoked to decide whether or not to focus on | |
120 | # a given window. It returns 1 if it's OK to focus on the window, | |
121 | # 0 if it's not OK. The code first checks whether the window is | |
122 | # viewable. If not, then it never focuses on the window. Then it | |
123 | # checks the -takefocus option for the window and uses it if it's | |
124 | # set. If there's no -takefocus option, the procedure checks to | |
125 | # see if (a) the widget isn't disabled, and (b) it has some key | |
126 | # bindings. If all of these are true, then 1 is returned. | |
127 | # | |
128 | # Arguments: | |
129 | # w - Name of a window. | |
130 | ||
131 | proc ::tk::FocusOK w { | |
132 | set code [catch {$w cget -takefocus} value] | |
133 | if {($code == 0) && ($value != "")} { | |
134 | if {$value == 0} { | |
135 | return 0 | |
136 | } elseif {$value == 1} { | |
137 | return [winfo viewable $w] | |
138 | } else { | |
139 | set value [uplevel #0 $value [list $w]] | |
140 | if {$value != ""} { | |
141 | return $value | |
142 | } | |
143 | } | |
144 | } | |
145 | if {![winfo viewable $w]} { | |
146 | return 0 | |
147 | } | |
148 | set code [catch {$w cget -state} value] | |
149 | if {($code == 0) && [string equal $value "disabled"]} { | |
150 | return 0 | |
151 | } | |
152 | regexp Key|Focus "[bind $w] [bind [winfo class $w]]" | |
153 | } | |
154 | ||
155 | # ::tk_focusFollowsMouse -- | |
156 | # | |
157 | # If this procedure is invoked, Tk will enter "focus-follows-mouse" | |
158 | # mode, where the focus is always on whatever window contains the | |
159 | # mouse. If this procedure isn't invoked, then the user typically | |
160 | # has to click on a window to give it the focus. | |
161 | # | |
162 | # Arguments: | |
163 | # None. | |
164 | ||
165 | proc ::tk_focusFollowsMouse {} { | |
166 | set old [bind all <Enter>] | |
167 | set script { | |
168 | if {[string equal "%d" "NotifyAncestor"] \ | |
169 | || [string equal "%d" "NotifyNonlinear"] \ | |
170 | || [string equal "%d" "NotifyInferior"]} { | |
171 | if {[tk::FocusOK %W]} { | |
172 | focus %W | |
173 | } | |
174 | } | |
175 | } | |
176 | if {[string compare $old ""]} { | |
177 | bind all <Enter> "$old; $script" | |
178 | } else { | |
179 | bind all <Enter> $script | |
180 | } | |
181 | } |