Initial revision

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
+    }
+}