| # focus.tcl -- |
| # |
| # This file defines several procedures for managing the input |
| # focus. |
| # |
| # RCS: @(#) $Id: focus.tcl,v 1.9 2001/08/01 16:21:11 dgp Exp $ |
| # |
| # 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 |
| } |
| } |