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.4.1 2006/01/25 18:21:41 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
25proc ::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 {[winfo toplevel $cur] eq $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 {[winfo toplevel $cur] eq $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 {$w eq $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
77proc ::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 {[winfo toplevel $cur] eq $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 {[winfo toplevel $cur] eq $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 {$w eq $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
131proc ::tk::FocusOK w {
132    set code [catch {$w cget -takefocus} value]
133    if {($code == 0) && ($value ne "")} {
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 ne ""} {
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) && $value eq "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
165proc ::tk_focusFollowsMouse {} {
166    set old [bind all <Enter>]
167    set script {
168	if {"%d" eq "NotifyAncestor" \
169		|| "%d" eq "NotifyNonlinear" \
170		|| "%d" eq "NotifyInferior"} {
171	    if {[tk::FocusOK %W]} {
172		focus %W
173	    }
174	}
175    }
176    if {$old ne ""} {
177	bind all <Enter> "$old; $script"
178    } else {
179	bind all <Enter> $script
180    }
181}
182