# This file defines several procedures for managing the input
# RCS: @(#) $Id: focus.tcl,v 1.9 2001/08/01 16:21:11 dgp Exp $
# Copyright (c) 1994-1995 Sun Microsystems, Inc.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
# This procedure returns the name of the next window after "w" in
# "focus order" (the window that should receive the focus next if
# Tab is typed in w). "Next" is defined by a pre-order search
# of a top-level and its non-top-level descendants, with the stacking
# order determining the order of siblings. The "-takefocus" options
# on windows determine whether or not they should be skipped.
# Descend to just before the first child of the current widget.
set children
[winfo children
$cur]
# Look for the next sibling that isn't a top-level.
if {$i < [llength $children]} {
set cur
[lindex $children $i]
if {[string equal
[winfo toplevel $cur] $cur]} {
# No more siblings, so go to the current widget's parent.
# If it's a top-level, break out of the loop, otherwise
# look for its next sibling.
if {[string equal
[winfo toplevel $cur] $cur]} {
set parent
[winfo parent
$parent]
set children
[winfo children
$parent]
set i
[lsearch -exact $children $cur]
if {[string equal
$w $cur] ||
[tk::FocusOK $cur]} {
# This procedure returns the name of the previous window before "w" in
# "focus order" (the window that should receive the focus next if
# Shift-Tab is typed in w). "Next" is defined by a pre-order search
# of a top-level and its non-top-level descendants, with the stacking
# order determining the order of siblings. The "-takefocus" options
# on windows determine whether or not they should be skipped.
# Collect information about the current window's position
# among its siblings. Also, if the window is a top-level,
# then reposition to just after the last child of the window.
if {[string equal
[winfo toplevel $cur] $cur]} {
set children
[winfo children
$cur]
set i
[llength $children]
set parent
[winfo parent
$cur]
set children
[winfo children
$parent]
set i
[lsearch -exact $children $cur]
# Go to the previous sibling, then descend to its last descendant
# (highest in stacking order. While doing this, ignore top-levels
# and their descendants. When we run out of descendants, go up
# one level to the parent.
set cur
[lindex $children $i]
if {[string equal
[winfo toplevel $cur] $cur]} {
set children
[winfo children
$parent]
set i
[llength $children]
if {[string equal
$w $cur] ||
[tk::FocusOK $cur]} {
# This procedure is invoked to decide whether or not to focus on
# a given window. It returns 1 if it's OK to focus on the window,
# 0 if it's not OK. The code first checks whether the window is
# viewable. If not, then it never focuses on the window. Then it
# checks the -takefocus option for the window and uses it if it's
# set. If there's no -takefocus option, the procedure checks to
# see if (a) the widget isn't disabled, and (b) it has some key
# bindings. If all of these are true, then 1 is returned.
set code
[catch {$w cget
-takefocus} value
]
if {($code == 0) && ($value != "")} {
return [winfo viewable
$w]
set value
[uplevel #0 $value [list $w]]
if {![winfo viewable
$w]} {
set code
[catch {$w cget
-state} value
]
if {($code == 0) && [string equal
$value "disabled"]} {
regexp Key|Focus
"[bind $w] [bind [winfo class $w]]"
# ::tk_focusFollowsMouse --
# If this procedure is invoked, Tk will enter "focus-follows-mouse"
# mode, where the focus is always on whatever window contains the
# mouse. If this procedure isn't invoked, then the user typically
# has to click on a window to give it the focus.
proc ::tk_focusFollowsMouse {} {
set old
[bind all
<Enter
>]
if {[string equal
"%d" "NotifyAncestor"] \
||
[string equal
"%d" "NotifyNonlinear"] \
||
[string equal
"%d" "NotifyInferior"]} {
if {[string compare
$old ""]} {
bind all
<Enter
> "$old; $script"