![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to tk.tcl CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Micropolis - Activity] / micropolis / src / tk / library|
Return to tk.tcl CVS log | Up to [Micropolis - Activity] / micropolis / src / tk / library |
1.1 root 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) {}
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.