focus.tcl (4857B)
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 }