+++ /dev/null
-# 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
- }
-}
OSDN Git Service
