figenc

[RADIOACTIVE] rsa and symmetric key encryption scripts and executables
git clone git://git.figbert.com/figenc.git
Log | Files | Refs | README

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 }