]> git.zerfleddert.de Git - micropolis/blob - src/tk/library/tk.tcl
871e39a5a762b19c7852c483625f2f7807dc01cc
[micropolis] / src / tk / library / tk.tcl
1 # tk.tcl --
2 #
3 # Initialization script normally executed in the interpreter for each
4 # Tk-based application. Arranges class bindings for widgets.
5 #
6 # $Header: /user6/ouster/wish/scripts/RCS/tk.tcl,v 1.19 92/08/08 14:50:08 ouster Exp $ SPRITE (Berkeley)
7 #
8 # Copyright 1992 Regents of the University of California
9 # Permission to use, copy, modify, and distribute this
10 # software and its documentation for any purpose and without
11 # fee is hereby granted, provided that this copyright
12 # notice appears in all copies. The University of California
13 # makes no representations about the suitability of this
14 # software for any purpose. It is provided "as is" without
15 # express or implied warranty.
16
17 # Insist on running with a compatible version of Tcl.
18
19 if "[info tclversion] != {6.4}" {
20 error "wrong version of Tcl loaded ([info tclversion]): need 6.4"
21 }
22
23 # Initialize the auto-load path to include Tk's directory as well as
24 # Tcl's directory:
25
26 set auto_path "$tk_library [info library]"
27
28 # Turn off strict Motif look and feel as a default.
29
30 set tk_strictMotif 0
31
32 # ----------------------------------------------------------------------
33 # Class bindings for various flavors of button widgets. $tk_priv(window)
34 # keeps track of the button containing the mouse, and $tk_priv(relief)
35 # saves the original relief of the button so it can be restored when
36 # the mouse button is released.
37 # ----------------------------------------------------------------------
38
39 bind Button <Any-Enter> {tk_butEnter %W}
40 bind Button <Any-Leave> {tk_butLeave %W}
41 bind Button <1> {tk_butDown %W}
42 bind Button <ButtonRelease-1> {tk_butUp %W}
43
44 bind CheckButton <Any-Enter> {tk_butEnter %W}
45 bind CheckButton <Any-Leave> {tk_butLeave %W}
46 bind CheckButton <1> {tk_butDown %W}
47 bind CheckButton <ButtonRelease-1> {tk_butUp %W}
48
49 bind RadioButton <Any-Enter> {tk_butEnter %W}
50 bind RadioButton <Any-Leave> {tk_butLeave %W}
51 bind RadioButton <1> {tk_butDown %W}
52 bind RadioButton <ButtonRelease-1> {tk_butUp %W}
53
54 # ----------------------------------------------------------------------
55 # Class bindings for entry widgets.
56 # ----------------------------------------------------------------------
57
58 bind Entry <1> {
59 %W cursor @%x
60 %W select from @%x
61 if {[lindex [%W config -state] 4] == "normal"} {focus %W}
62 }
63 bind Entry <B1-Motion> {%W select to @%x}
64 bind Entry <Shift-1> {%W select adjust @%x}
65 bind Entry <Shift-B1-Motion> {%W select to @%x}
66 bind Entry <2> {%W scan mark %x}
67 bind Entry <B2-Motion> {%W scan dragto %x}
68 bind Entry <Any-KeyPress> {
69 if {"%A" != ""} {
70 %W insert cursor %A
71 tk_entrySeeCaret %W
72 }
73 }
74 bind Entry <Delete> {tk_entryBackspace %W; tk_entrySeeCaret %W}
75 bind Entry <BackSpace> {tk_entryBackspace %W; tk_entrySeeCaret %W}
76 bind Entry <Control-h> {tk_entryBackspace %W; tk_entrySeeCaret %W}
77 bind Entry <Control-d> {%W delete sel.first sel.last; tk_entrySeeCaret %W}
78 bind Entry <Control-u> {%W delete 0 end}
79 bind Entry <Control-v> {%W insert cursor [selection get]; tk_entrySeeCaret %W}
80 bind Entry <Control-w> {tk_entryBackword %W; tk_entrySeeCaret %W}
81 tk_bindForTraversal Entry
82
83 # ----------------------------------------------------------------------
84 # Class bindings for listbox widgets.
85 # ----------------------------------------------------------------------
86
87 bind Listbox <1> {%W select from [%W nearest %y]}
88 bind Listbox <B1-Motion> {%W select to [%W nearest %y]}
89 bind Listbox <Shift-1> {%W select adjust [%W nearest %y]}
90 bind Listbox <Shift-B1-Motion> {%W select to [%W nearest %y]}
91 bind Listbox <2> {%W scan mark %x %y}
92 bind Listbox <B2-Motion> {%W scan dragto %x %y}
93
94 # ----------------------------------------------------------------------
95 # Class bindings for scrollbar widgets. When strict Motif is requested,
96 # the bindings use $tk_priv(buttons) and $tk_priv(activeFg) to set the
97 # -activeforeground color to -foreground when the mouse is in the window
98 # and restore it when the mouse leaves.
99 # ----------------------------------------------------------------------
100
101 bind Scrollbar <Any-Enter> {
102 if $tk_strictMotif {
103 set tk_priv(activeFg) [lindex [%W config -activeforeground] 4]
104 %W config -activeforeground [lindex [%W config -foreground] 4]
105 }
106 }
107 bind Scrollbar <Any-Leave> {
108 if {$tk_strictMotif && ($tk_priv(buttons) == 0)} {
109 %W config -activeforeground $tk_priv(activeFg)
110 }
111 }
112 bind Scrollbar <Any-ButtonPress> {incr tk_priv(buttons)}
113 bind Scrollbar <Any-ButtonRelease> {incr tk_priv(buttons) -1}
114
115 # ----------------------------------------------------------------------
116 # Class bindings for scale widgets. When strict Motif is requested,
117 # the bindings use $tk_priv(buttons) and $tk_priv(activeFg) to set the
118 # -activeforeground color to -foreground when the mouse is in the window
119 # and restore it when the mouse leaves.
120 # ----------------------------------------------------------------------
121
122 bind Scale <Any-Enter> {
123 if $tk_strictMotif {
124 set tk_priv(activeFg) [lindex [%W config -activeforeground] 4]
125 %W config -activeforeground [lindex [%W config -sliderforeground] 4]
126 }
127 }
128 bind Scale <Any-Leave> {
129 if {$tk_strictMotif && ($tk_priv(buttons) == 0)} {
130 %W config -activeforeground $tk_priv(activeFg)
131 }
132 }
133 bind Scale <Any-ButtonPress> {incr tk_priv(buttons)}
134 bind Scale <Any-ButtonRelease> {incr tk_priv(buttons) -1}
135
136 # ----------------------------------------------------------------------
137 # Class bindings for menubutton widgets. Variables used:
138 # $tk_priv(posted) - keeps track of the menubutton whose menu is
139 # currently posted (or empty string, if none).
140 # $tk_priv(inMenuButton)- if non-null, identifies menu button
141 # containing mouse pointer.
142 # $tk_priv(relief) - keeps track of original relief of posted
143 # menu button, so it can be restored later.
144 # $tk_priv(dragging) - if non-null, identifies menu button whose
145 # menu is currently being dragged in a tear-off
146 # operation.
147 # $tk_priv(focus) - records old focus window so focus can be
148 # returned there after keyboard traversal
149 # to menu.
150 # ----------------------------------------------------------------------
151
152 bind Menubutton <Enter> {
153 set tk_priv(inMenuButton) %W
154 if {[lindex [%W config -state] 4] != "disabled"} {
155 if {!$tk_strictMotif} {
156 %W config -state active
157 }
158 }
159 }
160 bind Menubutton <Any-Leave> {
161 set tk_priv(inMenuButton) {}
162 if {[lindex [%W config -state] 4] != "disabled"} {
163 if {!$tk_strictMotif} {
164 %W config -state normal
165 }
166 }
167 }
168 bind Menubutton <1> {tk_mbButtonDown %W}
169 bind Menubutton <Any-ButtonRelease-1> {
170 if {($tk_priv(inMenuButton) != "") && ($tk_priv(posted) != "")} {
171 [lindex [$tk_priv(posted) config -menu] 4] activate 0
172 } else {
173 tk_mbUnpost
174 }
175 }
176
177 # In the binding below, it's important to ignore grab-related entries
178 # and exits because they lag reality and can cause menus to chase
179 # their own tail, repeatedly posting and unposting.
180
181 bind Menubutton <B1-Enter> {
182 set tk_priv(inMenuButton) %W
183 if {([lindex [%W config -state] 4] != "disabled")
184 && ("%m" != "NotifyGrab") && ("%m" != "NotifyUngrab")} {
185 if {!$tk_strictMotif} {
186 %W config -state active
187 }
188 tk_mbPost %W
189 }
190 }
191 bind Menubutton <2> {
192 if {($tk_priv(posted) == "")
193 && ([lindex [%W config -state] 4] != "disabled")} {
194 set tk_priv(dragging) %W
195 [lindex [$tk_priv(dragging) config -menu] 4] post %X %Y
196 }
197 }
198 bind Menubutton <B2-Motion> {
199 if {$tk_priv(dragging) != ""} {
200 [lindex [$tk_priv(dragging) config -menu] 4] post %X %Y
201 }
202 }
203 bind Menubutton <ButtonRelease-2> {set tk_priv(dragging) ""}
204
205 # ----------------------------------------------------------------------
206 # Class bindings for menu widgets. $tk_priv(x) and $tk_priv(y) are used
207 # to keep track of the position of the mouse cursor in the menu window
208 # during dragging of tear-off menus. $tk_priv(window) keeps track of
209 # the menu containing the mouse, if any.
210 # ----------------------------------------------------------------------
211
212 bind Menu <Any-Enter> {set tk_priv(window) %W; %W activate @%y}
213 bind Menu <Any-Leave> {set tk_priv(window) {}; %W activate none}
214 bind Menu <Any-Motion> {
215 if {$tk_priv(window) != ""} {
216 %W activate @%y
217 }
218 }
219 bind Menu <ButtonRelease-1> {tk_invokeMenu %W}
220 bind Menu <2> {set tk_priv(x) %x; set tk_priv(y) %y}
221 bind Menu <B2-Motion> {
222 if {$tk_priv(posted) == ""} {
223 %W post [expr %X-$tk_priv(x)] [expr %Y-$tk_priv(y)]
224 }
225 }
226 bind Menu <B2-Leave> { }
227 bind Menu <B2-Enter> { }
228 bind Menu <Escape> {tk_mbUnpost}
229 bind Menu <Any-KeyPress> {tk_traverseWithinMenu %W %A}
230 bind Menu <Left> {tk_nextMenu -1}
231 bind Menu <Right> {tk_nextMenu 1}
232 bind Menu <Up> {tk_nextMenuEntry -1}
233 bind Menu <Down> {tk_nextMenuEntry 1}
234 bind Menu <Return> {tk_invokeMenu %W}
235
236 # ----------------------------------------------------------------------
237 # Class bindings for text widgets. $tk_priv(selectMode) holds one of
238 # "char", "word", or "line" to indicate which selection mode is active.
239 # ----------------------------------------------------------------------
240
241 bind Text <1> {
242 set tk_priv(selectMode) char
243 %W mark set insert @%x,%y
244 %W mark set anchor insert
245 if {[lindex [%W config -state] 4] == "normal"} {focus %W}
246 }
247 bind Text <Double-1> {
248 set tk_priv(selectMode) word
249 %W mark set insert "@%x,%y wordstart"
250 tk_textSelectTo %W insert
251 }
252 bind Text <Triple-1> {
253 set tk_priv(selectMode) line
254 %W mark set insert "@%x,%y linestart"
255 tk_textSelectTo %W insert
256 }
257 bind Text <B1-Motion> {tk_textSelectTo %W @%x,%y}
258 bind Text <Shift-1> {
259 tk_textResetAnchor %W @%x,%y
260 tk_textSelectTo %W @%x,%y
261 }
262 bind Text <Shift-B1-Motion> {tk_textSelectTo %W @%x,%y}
263 bind Text <2> {%W scan mark %y}
264 bind Text <B2-Motion> {%W scan dragto %y}
265 bind Text <Any-KeyPress> {
266 if {"%A" != ""} {
267 %W insert insert %A
268 %W yview -pickplace insert
269 }
270 }
271 bind Text <Return> {%W insert insert \n; %W yview -pickplace insert}
272 bind Text <BackSpace> {tk_textBackspace %W; %W yview -pickplace insert}
273 bind Text <Delete> {tk_textBackspace %W; %W yview -pickplace insert}
274 bind Text <Control-h> {tk_textBackspace %W; %W yview -pickplace insert}
275 bind Text <Control-d> {%W delete sel.first sel.last}
276 bind Text <Control-v> {
277 %W insert insert [selection get]
278 %W yview -pickplace insert
279 }
280 tk_bindForTraversal Text
281
282 # Initialize the elements of tk_priv that require initialization.
283
284 set tk_priv(buttons) 0
285 set tk_priv(dragging) {}
286 set tk_priv(focus) {}
287 set tk_priv(inMenuButton) {}
288 set tk_priv(posted) {}
289 set tk_priv(selectMode) char
290 set tk_priv(window) {}
Impressum, Datenschutz