1  # focus.tcl --
  2  #
  3  # This file defines several procedures for managing the input
  4  # focus.
  5  #
  6  # Copyright (c) 1994-1995 Sun Microsystems, Inc.
  7  #
  8  # See the file "license.terms" for information on usage and redistribution
  9  # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 10  #
 11  
 12  # ::tk_focusNext --
 13  # This procedure returns the name of the next window after "w" in
 14  # "focus order" (the window that should receive the focus next if
 15  # Tab is typed in w).  "Next" is defined by a pre-order search
 16  # of a top-level and its non-top-level descendants, with the stacking
 17  # order determining the order of siblings.  The "-takefocus" options
 18  # on windows determine whether or not they should be skipped.
 19  #
 20  # Arguments:
 21  # w -		Name of a window.
 22  
 23  proc ::tk_focusNext w {
 24      set cur $w
 25      while {1} {
 26  
 27  	# Descend to just before the first child of the current widget.
 28  
 29  	set parent $cur
 30  	set children [winfo children $cur]
 31  	set i -1
 32  
 33  	# Look for the next sibling that isn't a top-level.
 34  
 35  	while {1} {
 36  	    incr i
 37  	    if {$i < [llength $children]} {
 38  		set cur [lindex $children $i]
 39  		if {[winfo toplevel $cur] eq $cur} {
 40  		    continue
 41  		} else {
 42  		    break
 43  		}
 44  	    }
 45  
 46  	    # No more siblings, so go to the current widget's parent.
 47  	    # If it's a top-level, break out of the loop, otherwise
 48  	    # look for its next sibling.
 49  
 50  	    set cur $parent
 51  	    if {[winfo toplevel $cur] eq $cur} {
 52  		break
 53  	    }
 54  	    set parent [winfo parent $parent]
 55  	    set children [winfo children $parent]
 56  	    set i [lsearch -exact $children $cur]
 57  	}
 58  	if {$w eq $cur || [tk::FocusOK $cur]} {
 59  	    return $cur
 60  	}
 61      }
 62  }
 63  
 64  # ::tk_focusPrev --
 65  # This procedure returns the name of the previous window before "w" in
 66  # "focus order" (the window that should receive the focus next if
 67  # Shift-Tab is typed in w).  "Next" is defined by a pre-order search
 68  # of a top-level and its non-top-level descendants, with the stacking
 69  # order determining the order of siblings.  The "-takefocus" options
 70  # on windows determine whether or not they should be skipped.
 71  #
 72  # Arguments:
 73  # w -		Name of a window.
 74  
 75  proc ::tk_focusPrev w {
 76      set cur $w
 77      while {1} {
 78  
 79  	# Collect information about the current window's position
 80  	# among its siblings.  Also, if the window is a top-level,
 81  	# then reposition to just after the last child of the window.
 82  
 83  	if {[winfo toplevel $cur] eq $cur}  {
 84  	    set parent $cur
 85  	    set children [winfo children $cur]
 86  	    set i [llength $children]
 87  	} else {
 88  	    set parent [winfo parent $cur]
 89  	    set children [winfo children $parent]
 90  	    set i [lsearch -exact $children $cur]
 91  	}
 92  
 93  	# Go to the previous sibling, then descend to its last descendant
 94  	# (highest in stacking order.  While doing this, ignore top-levels
 95  	# and their descendants.  When we run out of descendants, go up
 96  	# one level to the parent.
 97  
 98  	while {$i > 0} {
 99  	    incr i -1
100  	    set cur [lindex $children $i]
101  	    if {[winfo toplevel $cur] eq $cur} {
102  		continue
103  	    }
104  	    set parent $cur
105  	    set children [winfo children $parent]
106  	    set i [llength $children]
107  	}
108  	set cur $parent
109  	if {$w eq $cur || [tk::FocusOK $cur]} {
110  	    return $cur
111  	}
112      }
113  }
114  
115  # ::tk::FocusOK --
116  #
117  # This procedure is invoked to decide whether or not to focus on
118  # a given window.  It returns 1 if it's OK to focus on the window,
119  # 0 if it's not OK.  The code first checks whether the window is
120  # viewable.  If not, then it never focuses on the window.  Then it
121  # checks the -takefocus option for the window and uses it if it's
122  # set.  If there's no -takefocus option, the procedure checks to
123  # see if (a) the widget isn't disabled, and (b) it has some key
124  # bindings.  If all of these are true, then 1 is returned.
125  #
126  # Arguments:
127  # w -		Name of a window.
128  
129  proc ::tk::FocusOK w {
130      set code [catch {$w cget -takefocus} value]
131      if {($code == 0) && ($value ne "")} {
132  	if {$value == 0} {
133  	    return 0
134  	} elseif {$value == 1} {
135  	    return [winfo viewable $w]
136  	} else {
137  	    set value [uplevel #0 $value [list $w]]
138  	    if {$value ne ""} {
139  		return $value
140  	    }
141  	}
142      }
143      if {![winfo viewable $w]} {
144  	return 0
145      }
146      set code [catch {$w cget -state} value]
147      if {($code == 0) && $value eq "disabled"} {
148  	return 0
149      }
150      regexp Key|Focus "[bind $w] [bind [winfo class $w]]"
151  }
152  
153  # ::tk_focusFollowsMouse --
154  #
155  # If this procedure is invoked, Tk will enter "focus-follows-mouse"
156  # mode, where the focus is always on whatever window contains the
157  # mouse.  If this procedure isn't invoked, then the user typically
158  # has to click on a window to give it the focus.
159  #
160  # Arguments:
161  # None.
162  
163  proc ::tk_focusFollowsMouse {} {
164      set old [bind all <Enter>]
165      set script {
166  	if {"%d" eq "NotifyAncestor" || "%d" eq "NotifyNonlinear" \
167  		|| "%d" eq "NotifyInferior"} {
168  	    if {[tk::FocusOK %W]} {
169  		focus %W
170  	    }
171  	}
172      }
173      if {$old ne ""} {
174  	bind all <Enter> "$old; $script"
175      } else {
176  	bind all <Enter> $script
177      }
178  }