OpenCores
URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tk/] [library/] [focus.tcl] - Blame information for rev 1765

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 578 markom 
# 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 
}

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.