diff options
Diffstat (limited to 'tk8.6/library/focus.tcl')
| -rw-r--r-- | tk8.6/library/focus.tcl | 178 |
1 files changed, 178 insertions, 0 deletions
diff --git a/tk8.6/library/focus.tcl b/tk8.6/library/focus.tcl new file mode 100644 index 0000000..640406e --- /dev/null +++ b/tk8.6/library/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 + } +} |