3 # Initialization script normally executed in the interpreter for each
4 # Tk-based application. Arranges class bindings for widgets.
6 # $Header: /user6/ouster/wish/scripts/RCS/tk.tcl,v 1.19 92/08/08 14:50:08 ouster Exp $ SPRITE (Berkeley)
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.
17 # Insist on running with a compatible version of Tcl.
19 if "[info tclversion] != {6.4}" {
20 error "wrong version of Tcl loaded ([info tclversion]): need 6.4"
23 # Initialize the auto-load path to include Tk's directory as well as
26 set auto_path
"$tk_library [info library]"
28 # Turn off strict Motif look and feel as a default.
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 # ----------------------------------------------------------------------
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
}
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
}
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
}
54 # ----------------------------------------------------------------------
55 # Class bindings for entry widgets.
56 # ----------------------------------------------------------------------
61 if {[lindex [%W config
-state] 4] == "normal"} {focus %W
}
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
> {
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
83 # ----------------------------------------------------------------------
84 # Class bindings for listbox widgets.
85 # ----------------------------------------------------------------------
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
}
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 # ----------------------------------------------------------------------
101 bind Scrollbar
<Any-Enter
> {
103 set tk_priv
(activeFg
) [lindex [%W config
-activeforeground] 4]
104 %W config
-activeforeground [lindex [%W config
-foreground] 4]
107 bind Scrollbar
<Any-Leave
> {
108 if {$tk_strictMotif && ($tk_priv(buttons
) == 0)} {
109 %W config
-activeforeground $tk_priv(activeFg
)
112 bind Scrollbar
<Any-ButtonPress
> {incr tk_priv
(buttons
)}
113 bind Scrollbar
<Any-ButtonRelease
> {incr tk_priv
(buttons
) -1}
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 # ----------------------------------------------------------------------
122 bind Scale
<Any-Enter
> {
124 set tk_priv
(activeFg
) [lindex [%W config
-activeforeground] 4]
125 %W config
-activeforeground [lindex [%W config
-sliderforeground] 4]
128 bind Scale
<Any-Leave
> {
129 if {$tk_strictMotif && ($tk_priv(buttons
) == 0)} {
130 %W config
-activeforeground $tk_priv(activeFg
)
133 bind Scale
<Any-ButtonPress
> {incr tk_priv
(buttons
)}
134 bind Scale
<Any-ButtonRelease
> {incr tk_priv
(buttons
) -1}
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
147 # $tk_priv(focus) - records old focus window so focus can be
148 # returned there after keyboard traversal
150 # ----------------------------------------------------------------------
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
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
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
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.
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
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
198 bind Menubutton
<B2-Motion
> {
199 if {$tk_priv(dragging
) != ""} {
200 [lindex [$tk_priv(dragging
) config
-menu] 4] post
%X
%Y
203 bind Menubutton
<ButtonRelease-2
> {set tk_priv
(dragging
) ""}
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 # ----------------------------------------------------------------------
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
) != ""} {
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
)]
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
}
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 # ----------------------------------------------------------------------
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
}
247 bind Text
<Double-1
> {
248 set tk_priv
(selectMode
) word
249 %W mark
set insert
"@%x,%y wordstart"
250 tk_textSelectTo
%W insert
252 bind Text
<Triple-1
> {
253 set tk_priv
(selectMode
) line
254 %W mark
set insert
"@%x,%y linestart"
255 tk_textSelectTo
%W insert
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
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
> {
268 %W yview
-pickplace insert
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
280 tk_bindForTraversal Text
282 # Initialize the elements of tk_priv that require initialization.
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
) {}