SGI/util/SGI/lib/tk8.0/focus.tcl

   1 # focus.tcl --
   2 #
   3 # This file defines several procedures for managing the input
   4 # focus.
   5 #
   6 # SCCS: @(#) focus.tcl 1.17 96/02/16 10:48:21
   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
  25 proc 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] == $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] == $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 {($cur == $w) || [tkFocusOK $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
  77 proc 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] == $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] == $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 {($cur == $w) || [tkFocusOK $cur]} {
 112             return $cur
 113         }
 114     }
 115 }
 116
 117 # tkFocusOK --
 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
 131 proc tkFocusOK w {
 132     set code [catch {$w cget -takefocus} value]
 133     if {($code == 0) && ($value != "")} {
 134         if {$value == 0} {
 135             return 0
 136         } elseif {$value == 1} {
 137             return [winfo viewable $w]
 138         } else {
 139             set value [uplevel #0 $value $w]
 140             if {$value != ""} {
 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 == "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
 165 proc tk_focusFollowsMouse {} {
 166     set old [bind all <Enter>]
 167     set script {
 168         if {("%d" == "NotifyAncestor") || ("%d" == "NotifyNonlinear")
 169                 || ("%d" == "NotifyInferior")} {
 170             if [tkFocusOK %W] {
 171                 focus %W
 172             }
 173         }
 174     }
 175     if {$old != ""} {
 176         bind all <Enter> "$old; $script"
 177     } else {
 178         bind all <Enter> $script
 179     }
 180 }