]> git.zerfleddert.de Git - micropolis/blame - res/tk.tlb
XINCLUDE: use /usr/X11R6/include everywhere
[micropolis] / res / tk.tlb
CommitLineData
6a5fa4e0
MG
1#@package: button.tcl tk_butEnter tk_butLeave tk_butDown tk_butUp
2
3# button.tcl --
4#
5# This file contains Tcl procedures used to manage Tk buttons.
6#
7# $Header: /user6/ouster/wish/scripts/RCS/button.tcl,v 1.7 92/07/28 15:41:13 ouster Exp $ SPRITE (Berkeley)
8#
9# Copyright 1992 Regents of the University of California
10# Permission to use, copy, modify, and distribute this
11# software and its documentation for any purpose and without
12# fee is hereby granted, provided that this copyright
13# notice appears in all copies. The University of California
14# makes no representations about the suitability of this
15# software for any purpose. It is provided "as is" without
16# express or implied warranty.
17#
18
19# The procedure below is invoked when the mouse pointer enters a
20# button widget. It records the button we're in and changes the
21# state of the button to active unless the button is disabled.
22
23proc tk_butEnter w {
24 global tk_priv tk_strictMotif
25 if {[lindex [$w config -state] 4] != "disabled"} {
26 if {!$tk_strictMotif} {
27 $w config -state active
28 }
29 set tk_priv(window) $w
30 }
31}
32
33# The procedure below is invoked when the mouse pointer leaves a
34# button widget. It changes the state of the button back to
35# inactive.
36
37proc tk_butLeave w {
38 global tk_priv tk_strictMotif
39 if {[lindex [$w config -state] 4] != "disabled"} {
40 if {!$tk_strictMotif} {
41 $w config -state normal
42 }
43 }
44 set tk_priv(window) ""
45}
46
47# The procedure below is invoked when the mouse button is pressed in
48# a button/radiobutton/checkbutton widget. It records information
49# (a) to indicate that the mouse is in the button, and
50# (b) to save the button's relief so it can be restored later.
51
52proc tk_butDown w {
53 global tk_priv
54 set tk_priv(relief) [lindex [$w config -relief] 4]
55 if {[lindex [$w config -state] 4] != "disabled"} {
56 $w config -relief sunken
57 }
58}
59
60# The procedure below is invoked when the mouse button is released
61# for a button/radiobutton/checkbutton widget. It restores the
62# button's relief and invokes the command as long as the mouse
63# hasn't left the button.
64
65proc tk_butUp w {
66 global tk_priv
67 $w config -relief $tk_priv(relief)
68 if {($w == $tk_priv(window))
69 && ([lindex [$w config -state] 4] != "disabled")} {
70 uplevel #0 [list $w invoke]
71 }
72}
73#@package: listbox.tcl tk_listboxSingleSelect
74
75# listbox.tcl --
76#
77# This file contains Tcl procedures used to manage Tk listboxes.
78#
79# $Header: /user6/ouster/wish/scripts/RCS/listbox.tcl,v 1.2 92/06/03 15:21:28 ouster Exp $ SPRITE (Berkeley)
80#
81# Copyright 1992 Regents of the University of California
82# Permission to use, copy, modify, and distribute this
83# software and its documentation for any purpose and without
84# fee is hereby granted, provided that this copyright
85# notice appears in all copies. The University of California
86# makes no representations about the suitability of this
87# software for any purpose. It is provided "as is" without
88# express or implied warranty.
89#
90
91# The procedure below may be invoked to change the behavior of
92# listboxes so that only a single item may be selected at once.
93# The arguments give one or more windows whose behavior should
94# be changed; if one of the arguments is "Listbox" then the default
95# behavior is changed for all listboxes.
96
97proc tk_listboxSingleSelect args {
98 foreach w $args {
99 bind $w <B1-Motion> {%W select from [%W nearest %y]}
100 bind $w <Shift-1> {%W select from [%W nearest %y]}
101 bind $w <Shift-B1-Motion> {%W select from [%W nearest %y]}
102 }
103}
104#@package: tkerror.tcl tkerror
105
106# This file contains a default version of the tkError procedure. It
107# just prints out a stack trace.
108
109proc tkerror err {
110 global errorInfo
111 puts stdout "$errorInfo"
112}
113#@package: text.tcl tk_textSelectTo tk_textBackspace tk_textIndexCloser tk_textResetAnchor
114
115# text.tcl --
116#
117# This file contains Tcl procedures used to manage Tk entries.
118#
119# $Header: /user6/ouster/wish/scripts/RCS/text.tcl,v 1.2 92/07/16 16:26:33 ouster Exp $ SPRITE (Berkeley)
120#
121# Copyright 1992 Regents of the University of California
122# Permission to use, copy, modify, and distribute this
123# software and its documentation for any purpose and without
124# fee is hereby granted, provided that this copyright
125# notice appears in all copies. The University of California
126# makes no representations about the suitability of this
127# software for any purpose. It is provided "as is" without
128# express or implied warranty.
129#
130
131# The procedure below is invoked when dragging one end of the selection.
132# The arguments are the text window name and the index of the character
133# that is to be the new end of the selection.
134
135proc tk_textSelectTo {w index} {
136 global tk_priv
137
138 case $tk_priv(selectMode) {
139 char {
140 if [$w compare $index < anchor] {
141 set first $index
142 set last anchor
143 } else {
144 set first anchor
145 set last [$w index $index+1c]
146 }
147 }
148 word {
149 if [$w compare $index < anchor] {
150 set first [$w index "$index wordstart"]
151 set last [$w index "anchor wordend"]
152 } else {
153 set first [$w index "anchor wordstart"]
154 set last [$w index "$index wordend"]
155 }
156 }
157 line {
158 if [$w compare $index < anchor] {
159 set first [$w index "$index linestart"]
160 set last [$w index "anchor lineend + 1c"]
161 } else {
162 set first [$w index "anchor linestart"]
163 set last [$w index "$index lineend + 1c"]
164 }
165 }
166 }
167 $w tag remove sel 0.0 $first
168 $w tag add sel $first $last
169 $w tag remove sel $last end
170}
171
172# The procedure below is invoked to backspace over one character in
173# a text widget. The name of the widget is passed as argument.
174
175proc tk_textBackspace w {
176 $w delete insert-1c insert
177}
178
179# The procedure below compares three indices, a, b, and c. Index b must
180# be less than c. The procedure returns 1 if a is closer to b than to c,
181# and 0 otherwise. The "w" argument is the name of the text widget in
182# which to do the comparison.
183
184proc tk_textIndexCloser {w a b c} {
185 set a [$w index $a]
186 set b [$w index $b]
187 set c [$w index $c]
188 if [$w compare $a <= $b] {
189 return 1
190 }
191 if [$w compare $a >= $c] {
192 return 0
193 }
194 scan $a "%d.%d" lineA chA
195 scan $b "%d.%d" lineB chB
196 scan $c "%d.%d" lineC chC
197 if {$chC == 0} {
198 incr lineC -1
199 set chC [string length [$w get $lineC.0 $lineC.end]]
200 }
201 if {$lineB != $lineC} {
202 return [expr {($lineA-$lineB) < ($lineC-$lineA)}]
203 }
204 return [expr {($chA-$chB) < ($chC-$chA)}]
205}
206
207# The procedure below is called to reset the selection anchor to
208# whichever end is FARTHEST from the index argument.
209
210proc tk_textResetAnchor {w index} {
211 global tk_priv
212 if {[$w tag ranges sel] == ""} {
213 set tk_priv(selectMode) char
214 $w mark set anchor $index
215 return
216 }
217 if [tk_textIndexCloser $w $index sel.first sel.last] {
218 if {$tk_priv(selectMode) == "char"} {
219 $w mark set anchor sel.last
220 } else {
221 $w mark set anchor sel.last-1c
222 }
223 } else {
224 $w mark set anchor sel.first
225 }
226}
227#@package: menu.tcl tk_menus tk_bindForTraversal tk_mbPost tk_mbUnpost tk_traverseToMenu tk_traverseWithinMenu tk_getMenuButtons tk_nextMenu tk_nextMenuEntry tk_invokeMenu tk_firstMenu
228
229# menu.tcl --
230#
231# This file contains Tcl procedures used to manage Tk menus and
232# menubuttons. Most of the code here is dedicated to support for
233# menu traversal via the keyboard.
234#
235# $Header: /user6/ouster/wish/scripts/RCS/menu.tcl,v 1.11 92/08/08 14:49:55 ouster Exp $ SPRITE (Berkeley)
236#
237# Copyright 1992 Regents of the University of California
238# Permission to use, copy, modify, and distribute this
239# software and its documentation for any purpose and without
240# fee is hereby granted, provided that this copyright
241# notice appears in all copies. The University of California
242# makes no representations about the suitability of this
243# software for any purpose. It is provided "as is" without
244# express or implied warranty.
245#
246
247# The procedure below is publically available. It is used to indicate
248# the menus associated with a particular top-level window, for purposes
249# of keyboard menu traversal. Its first argument is the path name of
250# a top-level window, and any additional arguments are the path names of
251# the menu buttons associated with that top-level window, in the order
252# they should be traversed. If no menu buttons are named, the procedure
253# returns the current list of menus for w. If a single empty string is
254# supplied, then the menu list for w is cancelled. Otherwise, tk_menus
255# sets the menu list for w to the menu buttons.
256
257proc tk_menus {w args} {
258 global tk_priv
259
260 if {$args == ""} {
261 if [catch {set result [set tk_priv(menusFor$w)]}] {
262 return ""
263 }
264 return $result
265 }
266
267 if {$args == "{}"} {
268 catch {unset tk_priv(menusFor$w)}
269 return ""
270 }
271
272 set tk_priv(menusFor$w) $args
273}
274
275# The procedure below is publically available. It takes any number of
276# arguments taht are names of widgets or classes. It sets up bindings
277# for the widgets or classes so that keyboard menu traversal is possible
278# when the input focus is in those widgets or classes.
279
280proc tk_bindForTraversal args {
281 foreach w $args {
282 bind $w <Alt-KeyPress> {tk_traverseToMenu %W %A}
283 bind $w <F10> {tk_firstMenu %W}
284 }
285}
286
287# The procedure below does all of the work of posting a menu (including
288# unposting any other menu that might currently be posted). The "w"
289# argument is the name of the menubutton for the menu to be posted.
290# Note: if $w is disabled then the procedure does nothing.
291
292proc tk_mbPost {w} {
293 global tk_priv tk_strictMotif
294 if {[lindex [$w config -state] 4] == "disabled"} {
295 return
296 }
297 set cur $tk_priv(posted)
298 if {$cur == $w} {
299 return
300 }
301 if {$cur != ""} tk_mbUnpost
302 set tk_priv(relief) [lindex [$w config -relief] 4]
303 $w config -relief raised
304 set tk_priv(cursor) [lindex [$w config -cursor] 4]
305 $w config -cursor arrow
306 $w post
307 grab -global $w
308 set tk_priv(posted) $w
309 if {$tk_priv(focus) == ""} {
310 set tk_priv(focus) [focus]
311 }
312 set menu [lindex [$w config -menu] 4]
313 set tk_priv(activeBg) [lindex [$menu config -activebackground] 4]
314 set tk_priv(activeFg) [lindex [$menu config -activeforeground] 4]
315 if $tk_strictMotif {
316 $menu config -activebackground [lindex [$menu config -background] 4]
317 $menu config -activeforeground [lindex [$menu config -foreground] 4]
318 }
319 focus $menu
320}
321
322# The procedure below does all the work of unposting the menubutton that's
323# currently posted. It takes no arguments.
324
325proc tk_mbUnpost {} {
326 global tk_priv
327 if {$tk_priv(posted) != ""} {
328 $tk_priv(posted) config -relief $tk_priv(relief)
329 $tk_priv(posted) config -cursor $tk_priv(cursor)
330 $tk_priv(posted) config -activebackground $tk_priv(activeBg)
331 $tk_priv(posted) config -activeforeground $tk_priv(activeFg)
332 $tk_priv(posted) unpost
333 grab none
334 focus $tk_priv(focus)
335 set tk_priv(focus) ""
336 set menu [lindex [$tk_priv(posted) config -menu] 4]
337 $menu config -activebackground $tk_priv(activeBg)
338 $menu config -activeforeground $tk_priv(activeFg)
339 set tk_priv(posted) {}
340 }
341}
342
343# The procedure below is invoked to implement keyboard traversal to
344# a menu button. It takes two arguments: the name of a window where
345# a keystroke originated, and the ascii character that was typed.
346# This procedure finds a menu bar by looking upward for a top-level
347# window, then looking for a window underneath that named "menu".
348# Then it searches through all the subwindows of "menu" for a menubutton
349# with an underlined character matching char. If one is found, it
350# posts that menu.
351
352proc tk_traverseToMenu {w char} {
353 global tk_priv
354 if {$char == ""} {
355 return
356 }
357 set char [string tolower $char]
358
359 foreach mb [tk_getMenuButtons $w] {
360 if {[winfo class $mb] == "Menubutton"} {
361 set char2 [string index [lindex [$mb config -text] 4] \
362 [lindex [$mb config -underline] 4]]
363 if {[string compare $char [string tolower $char2]] == 0} {
364 tk_mbPost $mb
365 [lindex [$mb config -menu] 4] activate 0
366 return
367 }
368 }
369 }
370}
371
372# The procedure below is used to implement keyboard traversal within
373# the posted menu. It takes two arguments: the name of the menu to
374# be traversed within, and an ASCII character. It searches for an
375# entry in the menu that has that character underlined. If such an
376# entry is found, it is invoked and the menu is unposted.
377
378proc tk_traverseWithinMenu {w char} {
379 if {$char == ""} {
380 return
381 }
382 set char [string tolower $char]
383 set last [$w index last]
384 for {set i 0} {$i <= $last} {incr i} {
385 if [catch {set char2 [string index \
386 [lindex [$w entryconfig $i -label] 4] \
387 [lindex [$w entryconfig $i -underline] 4]]}] {
388 continue
389 }
390 if {[string compare $char [string tolower $char2]] == 0} {
391 tk_mbUnpost
392 $w invoke $i
393 return
394 }
395 }
396}
397
398# The procedure below takes a single argument, which is the name of
399# a window. It returns a list containing path names for all of the
400# menu buttons associated with that window's top-level window, or an
401# empty list if there are none.
402
403proc tk_getMenuButtons w {
404 global tk_priv
405 set top [winfo toplevel $w]
406 if [catch {set buttons [set tk_priv(menusFor$top)]}] {
407 return ""
408 }
409 return $buttons
410}
411
412# The procedure below is used to traverse to the next or previous
413# menu in a menu bar. It takes one argument, which is a count of
414# how many menu buttons forward or backward (if negative) to move.
415# If there is no posted menu then this procedure has no effect.
416
417proc tk_nextMenu count {
418 global tk_priv
419 if {$tk_priv(posted) == ""} {
420 return
421 }
422 set buttons [tk_getMenuButtons $tk_priv(posted)]
423 set length [llength $buttons]
424 for {set i 0} 1 {incr i} {
425 if {$i >= $length} {
426 return
427 }
428 if {[lindex $buttons $i] == $tk_priv(posted)} {
429 break
430 }
431 }
432 incr i $count
433 while 1 {
434 while {$i < 0} {
435 incr i $length
436 }
437 while {$i >= $length} {
438 incr i -$length
439 }
440 set mb [lindex $buttons $i]
441 if {[lindex [$mb configure -state] 4] != "disabled"} {
442 break
443 }
444 incr i $count
445 }
446 tk_mbUnpost
447 tk_mbPost $mb
448 [lindex [$mb config -menu] 4] activate 0
449}
450
451# The procedure below is used to traverse to the next or previous entry
452# in the posted menu. It takes one argument, which is 1 to go to the
453# next entry or -1 to go to the previous entry. Disabled entries are
454# skipped in this process.
455
456proc tk_nextMenuEntry count {
457 global tk_priv
458 if {$tk_priv(posted) == ""} {
459 return
460 }
461 set menu [lindex [$tk_priv(posted) config -menu] 4]
462 set length [expr [$menu index last]+1]
463 set i [$menu index active]
464 if {$i == "none"} {
465 set i 0
466 } else {
467 incr i $count
468 }
469 while 1 {
470 while {$i < 0} {
471 incr i $length
472 }
473 while {$i >= $length} {
474 incr i -$length
475 }
476 if {[catch {$menu entryconfigure $i -state} state] == 0} {
477 if {[lindex $state 4] != "disabled"} {
478 break
479 }
480 }
481 incr i $count
482 }
483 $menu activate $i
484}
485
486# The procedure below invokes the active entry in the posted menu,
487# if there is one. Otherwise it does nothing.
488
489proc tk_invokeMenu {menu} {
490 set i [$menu index active]
491 if {$i != "none"} {
492 tk_mbUnpost
493 update idletasks
494 $menu invoke $i
495 }
496}
497
498# The procedure below is invoked to keyboard-traverse to the first
499# menu for a given source window. The source window is passed as
500# parameter.
501
502proc tk_firstMenu w {
503 set mb [lindex [tk_getMenuButtons $w] 0]
504 if {$mb != ""} {
505 tk_mbPost $mb
506 [lindex [$mb config -menu] 4] activate 0
507 }
508}
509
510# The procedure below is invoked when a button-1-down event is
511# received by a menu button. If the mouse is in the menu button
512# then it posts the button's menu. If the mouse isn't in the
513# button's menu, then it deactivates any active entry in the menu.
514# Remember, event-sharing can cause this procedure to be invoked
515# for two different menu buttons on the same event.
516
517proc tk_mbButtonDown w {
518 global tk_priv
519 if {[lindex [$w config -state] 4] == "disabled"} {
520 return
521 }
522 if {$tk_priv(inMenuButton) == $w} {
523 tk_mbPost $w
524 }
525 set menu [lindex [$tk_priv(posted) config -menu] 4]
526 if {$tk_priv(window) != $menu} {
527 $menu activate none
528 }
529}
530#@package: entry.tcl tk_entryBackspace tk_entryBackword tk_entrySeeCaret
531
532# entry.tcl --
533#
534# This file contains Tcl procedures used to manage Tk entries.
535#
536# $Header: /user6/ouster/wish/scripts/RCS/entry.tcl,v 1.2 92/05/23 16:40:57 ouster Exp $ SPRITE (Berkeley)
537#
538# Copyright 1992 Regents of the University of California
539# Permission to use, copy, modify, and distribute this
540# software and its documentation for any purpose and without
541# fee is hereby granted, provided that this copyright
542# notice appears in all copies. The University of California
543# makes no representations about the suitability of this
544# software for any purpose. It is provided "as is" without
545# express or implied warranty.
546#
547
548# The procedure below is invoked to backspace over one character
549# in an entry widget. The name of the widget is passed as argument.
550
551proc tk_entryBackspace w {
552 set x [expr {[$w index cursor] - 1}]
553 if {$x != -1} {$w delete $x}
554}
555
556# The procedure below is invoked to backspace over one word in an
557# entry widget. The name of the widget is passed as argument.
558
559proc tk_entryBackword w {
560 set string [$w get]
561 set curs [expr [$w index cursor]-1]
562 if {$curs < 0} return
563 for {set x $curs} {$x > 0} {incr x -1} {
564 if {([string first [string index $string $x] " \t"] < 0)
565 && ([string first [string index $string [expr $x-1]] " \t"]
566 >= 0)} {
567 break
568 }
569 }
570 $w delete $x $curs
571}
572
573# The procedure below is invoked after insertions. If the caret is not
574# visible in the window then the procedure adjusts the entry's view to
575# bring the caret back into the window again.
576
577proc tk_entrySeeCaret w {
578 set c [$w index cursor]
579 set left [$w index @0]
580 if {$left > $c} {
581 $w view $c
582 return
583 }
584 while {[$w index @[expr [winfo width $w]-5]] < $c} {
585 set left [expr $left+1]
586 $w view $left
587 }
588}
Impressum, Datenschutz