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