3 # This file defines several procedures for managing the input
6 # Copyright (c) 1994-1995 Sun Microsystems, Inc.
8 # See the file "license.terms" for information on usage and redistribution
9 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
13 # This procedure returns the name of the next window after "w" in
14 # "focus order" (the window that should receive the focus next if
15 # Tab is typed in w). "Next" is defined by a pre-order search
16 # of a top-level and its non-top-level descendants, with the stacking
17 # order determining the order of siblings. The "-takefocus" options
18 # on windows determine whether or not they should be skipped.
21 # w - Name of a window.
23 proc ::tk_focusNext w
{
27 # Descend to just before the first child of the current widget.
30 set children
[winfo children
$cur]
33 # Look for the next sibling that isn't a top-level.
37 if {$i < [llength $children]} {
38 set cur
[lindex $children $i]
39 if {[winfo toplevel $cur] eq
$cur} {
46 # No more siblings, so go to the current widget's parent.
47 # If it's a top-level, break out of the loop, otherwise
48 # look for its next sibling.
51 if {[winfo toplevel $cur] eq
$cur} {
54 set parent
[winfo parent
$parent]
55 set children
[winfo children
$parent]
56 set i
[lsearch -exact $children $cur]
58 if {$w eq
$cur ||
[tk::FocusOK $cur]} {
65 # This procedure returns the name of the previous window before "w" in
66 # "focus order" (the window that should receive the focus next if
67 # Shift-Tab is typed in w). "Next" is defined by a pre-order search
68 # of a top-level and its non-top-level descendants, with the stacking
69 # order determining the order of siblings. The "-takefocus" options
70 # on windows determine whether or not they should be skipped.
73 # w - Name of a window.
75 proc ::tk_focusPrev w
{
79 # Collect information about the current window's position
80 # among its siblings. Also, if the window is a top-level,
81 # then reposition to just after the last child of the window.
83 if {[winfo toplevel $cur] eq
$cur} {
85 set children
[winfo children
$cur]
86 set i
[llength $children]
88 set parent
[winfo parent
$cur]
89 set children
[winfo children
$parent]
90 set i
[lsearch -exact $children $cur]
93 # Go to the previous sibling, then descend to its last descendant
94 # (highest in stacking order. While doing this, ignore top-levels
95 # and their descendants. When we run out of descendants, go up
96 # one level to the parent.
100 set cur
[lindex $children $i]
101 if {[winfo toplevel $cur] eq
$cur} {
105 set children
[winfo children
$parent]
106 set i
[llength $children]
109 if {$w eq
$cur ||
[tk::FocusOK $cur]} {
117 # This procedure is invoked to decide whether or not to focus on
118 # a given window. It returns 1 if it's OK to focus on the window,
119 # 0 if it's not OK. The code first checks whether the window is
120 # viewable. If not, then it never focuses on the window. Then it
121 # checks the -takefocus option for the window and uses it if it's
122 # set. If there's no -takefocus option, the procedure checks to
123 # see if (a) the widget isn't disabled, and (b) it has some key
124 # bindings. If all of these are true, then 1 is returned.
127 # w - Name of a window.
129 proc ::tk::FocusOK w
{
130 set code
[catch {$w cget
-takefocus} value
]
131 if {($code == 0) && ($value ne
"")} {
134 } elseif
{$value == 1} {
135 return [winfo viewable
$w]
137 set value
[uplevel #0 $value [list $w]]
143 if {![winfo viewable
$w]} {
146 set code
[catch {$w cget
-state} value
]
147 if {($code == 0) && $value eq
"disabled"} {
150 regexp Key|Focus
"[bind $w] [bind [winfo class $w]]"
153 # ::tk_focusFollowsMouse --
155 # If this procedure is invoked, Tk will enter "focus-follows-mouse"
156 # mode, where the focus is always on whatever window contains the
157 # mouse. If this procedure isn't invoked, then the user typically
158 # has to click on a window to give it the focus.
163 proc ::tk_focusFollowsMouse {} {
164 set old
[bind all
<Enter
>]
166 if {"%d" eq
"NotifyAncestor" ||
"%d" eq
"NotifyNonlinear" \
167 ||
"%d" eq
"NotifyInferior"} {
168 if {[tk::FocusOK %W
]} {
174 bind all
<Enter
> "$old; $script"
176 bind all
<Enter
> $script