summaryrefslogtreecommitdiff
path: root/systems/texlive/tlnet/tlpkg/tltcl/lib/tk8.6/focus.tcl
diff options
context:
space:
mode:
Diffstat (limited to 'systems/texlive/tlnet/tlpkg/tltcl/lib/tk8.6/focus.tcl')
-rw-r--r--systems/texlive/tlnet/tlpkg/tltcl/lib/tk8.6/focus.tcl178
1 files changed, 178 insertions, 0 deletions
diff --git a/systems/texlive/tlnet/tlpkg/tltcl/lib/tk8.6/focus.tcl b/systems/texlive/tlnet/tlpkg/tltcl/lib/tk8.6/focus.tcl
new file mode 100644
index 0000000000..640406e4dd
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tltcl/lib/tk8.6/focus.tcl
@@ -0,0 +1,178 @@
+# focus.tcl --
+#
+# This file defines several procedures for managing the input
+# focus.
+#
+# 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] eq $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] eq $cur} {
+ break
+ }
+ set parent [winfo parent $parent]
+ set children [winfo children $parent]
+ set i [lsearch -exact $children $cur]
+ }
+ if {$w eq $cur || [tk::FocusOK $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] eq $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] eq $cur} {
+ continue
+ }
+ set parent $cur
+ set children [winfo children $parent]
+ set i [llength $children]
+ }
+ set cur $parent
+ if {$w eq $cur || [tk::FocusOK $cur]} {
+ return $cur
+ }
+ }
+}
+
+# ::tk::FocusOK --
+#
+# 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 ::tk::FocusOK w {
+ set code [catch {$w cget -takefocus} value]
+ if {($code == 0) && ($value ne "")} {
+ if {$value == 0} {
+ return 0
+ } elseif {$value == 1} {
+ return [winfo viewable $w]
+ } else {
+ set value [uplevel #0 $value [list $w]]
+ if {$value ne ""} {
+ return $value
+ }
+ }
+ }
+ if {![winfo viewable $w]} {
+ return 0
+ }
+ set code [catch {$w cget -state} value]
+ if {($code == 0) && $value eq "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" eq "NotifyAncestor" || "%d" eq "NotifyNonlinear" \
+ || "%d" eq "NotifyInferior"} {
+ if {[tk::FocusOK %W]} {
+ focus %W
+ }
+ }
+ }
+ if {$old ne ""} {
+ bind all <Enter> "$old; $script"
+ } else {
+ bind all <Enter> $script
+ }
+}