summaryrefslogtreecommitdiffstats
path: root/library/focus.tcl
diff options
context:
space:
mode:
authorrjohnson <rjohnson>1998-04-01 09:51:44 (GMT)
committerrjohnson <rjohnson>1998-04-01 09:51:44 (GMT)
commit066ea7fd88d49cb456f74da71dbe875e4fc0aabb (patch)
tree8fb30cb152c4dc191be47fa043d2e6f5ea38c7ba /library/focus.tcl
parent13242623d2ff3ea02ab6a62bfb48a7dbb5c27e22 (diff)
downloadtk-066ea7fd88d49cb456f74da71dbe875e4fc0aabb.zip
tk-066ea7fd88d49cb456f74da71dbe875e4fc0aabb.tar.gz
tk-066ea7fd88d49cb456f74da71dbe875e4fc0aabb.tar.bz2
Initial revision
Diffstat (limited to 'library/focus.tcl')
-rw-r--r--library/focus.tcl180
1 files changed, 180 insertions, 0 deletions
diff --git a/library/focus.tcl b/library/focus.tcl
new file mode 100644
index 0000000..bf0476d
--- /dev/null
+++ b/library/focus.tcl
@@ -0,0 +1,180 @@
+# focus.tcl --
+#
+# This file defines several procedures for managing the input
+# focus.
+#
+# SCCS: @(#) focus.tcl 1.17 96/02/16 10:48:21
+#
+# 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.
+#
+
+# tk_focusNext --
+# 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.
+#
+# Arguments:
+# w - Name of a window.
+
+proc tk_focusNext w {
+ set cur $w
+ while 1 {
+
+ # Descend to just before the first child of the current widget.
+
+ set parent $cur
+ set children [winfo children $cur]
+ set i -1
+
+ # Look for the next sibling that isn't a top-level.
+
+ while 1 {
+ incr i
+ if {$i < [llength $children]} {
+ set cur [lindex $children $i]
+ if {[winfo toplevel $cur] == $cur} {
+ continue
+ } else {
+ break
+ }
+ }
+
+ # 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.
+
+ set cur $parent
+ if {[winfo toplevel $cur] == $cur} {
+ break
+ }
+ set parent [winfo parent $parent]
+ set children [winfo children $parent]
+ set i [lsearch -exact $children $cur]
+ }
+ if {($cur == $w) || [tkFocusOK $cur]} {
+ return $cur
+ }
+ }
+}
+
+# tk_focusPrev --
+# 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.
+#
+# Arguments:
+# w - Name of a window.
+
+proc tk_focusPrev w {
+ set cur $w
+ while 1 {
+
+ # 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 {[winfo toplevel $cur] == $cur} {
+ set parent $cur
+ set children [winfo children $cur]
+ set i [llength $children]
+ } else {
+ 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.
+
+ while {$i > 0} {
+ incr i -1
+ set cur [lindex $children $i]
+ if {[winfo toplevel $cur] == $cur} {
+ continue
+ }
+ set parent $cur
+ set children [winfo children $parent]
+ set i [llength $children]
+ }
+ set cur $parent
+ if {($cur == $w) || [tkFocusOK $cur]} {
+ return $cur
+ }
+ }
+}
+
+# tkFocusOK --
+#
+# 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.
+#
+# Arguments:
+# w - Name of a window.
+
+proc tkFocusOK w {
+ set code [catch {$w cget -takefocus} value]
+ if {($code == 0) && ($value != "")} {
+ if {$value == 0} {
+ return 0
+ } elseif {$value == 1} {
+ return [winfo viewable $w]
+ } else {
+ set value [uplevel #0 $value $w]
+ if {$value != ""} {
+ return $value
+ }
+ }
+ }
+ if {![winfo viewable $w]} {
+ return 0
+ }
+ set code [catch {$w cget -state} value]
+ if {($code == 0) && ($value == "disabled")} {
+ return 0
+ }
+ 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.
+#
+# Arguments:
+# None.
+
+proc tk_focusFollowsMouse {} {
+ set old [bind all <Enter>]
+ set script {
+ if {("%d" == "NotifyAncestor") || ("%d" == "NotifyNonlinear")
+ || ("%d" == "NotifyInferior")} {
+ if [tkFocusOK %W] {
+ focus %W
+ }
+ }
+ }
+ if {$old != ""} {
+ bind all <Enter> "$old; $script"
+ } else {
+ bind all <Enter> $script
+ }
+}