diff options
Diffstat (limited to 'tcl/library/focus.tcl')
| -rw-r--r-- | tcl/library/focus.tcl | 181 |
1 files changed, 0 insertions, 181 deletions
diff --git a/tcl/library/focus.tcl b/tcl/library/focus.tcl deleted file mode 100644 index ea0f64de269..00000000000 --- a/tcl/library/focus.tcl +++ /dev/null @@ -1,181 +0,0 @@ -# focus.tcl -- -# -# This file defines several procedures for managing the input -# focus. -# -# RCS: @(#) $Id$ -# -# 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 {[string equal [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 {[string equal [winfo toplevel $cur] $cur]} { - break - } - set parent [winfo parent $parent] - set children [winfo children $parent] - set i [lsearch -exact $children $cur] - } - if {[string equal $w $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 {[string equal [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 {[string equal [winfo toplevel $cur] $cur]} { - continue - } - set parent $cur - set children [winfo children $parent] - set i [llength $children] - } - set cur $parent - if {[string equal $w $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 != "")} { - if {$value == 0} { - return 0 - } elseif {$value == 1} { - return [winfo viewable $w] - } else { - set value [uplevel #0 $value [list $w]] - if {$value != ""} { - return $value - } - } - } - if {![winfo viewable $w]} { - return 0 - } - set code [catch {$w cget -state} value] - if {($code == 0) && [string equal $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 {[string equal "%d" "NotifyAncestor"] \ - || [string equal "%d" "NotifyNonlinear"] \ - || [string equal "%d" "NotifyInferior"]} { - if {[tk::FocusOK %W]} { - focus %W - } - } - } - if {[string compare $old ""]} { - bind all <Enter> "$old; $script" - } else { - bind all <Enter> $script - } -} |