Commit | Line | Data |
---|---|---|
920dae64 AT |
1 | # listbox.tcl -- |
2 | # | |
3 | # This file defines the default bindings for Tk listbox widgets | |
4 | # and provides procedures that help in implementing those bindings. | |
5 | # | |
6 | # RCS: @(#) $Id: listbox.tcl,v 1.13.2.2 2004/02/17 07:17:17 das Exp $ | |
7 | # | |
8 | # Copyright (c) 1994 The Regents of the University of California. | |
9 | # Copyright (c) 1994-1995 Sun Microsystems, Inc. | |
10 | # Copyright (c) 1998 by Scriptics Corporation. | |
11 | # | |
12 | # See the file "license.terms" for information on usage and redistribution | |
13 | # of this file, and for a DISCLAIMER OF ALL WARRANTIES. | |
14 | ||
15 | #-------------------------------------------------------------------------- | |
16 | # tk::Priv elements used in this file: | |
17 | # | |
18 | # afterId - Token returned by "after" for autoscanning. | |
19 | # listboxPrev - The last element to be selected or deselected | |
20 | # during a selection operation. | |
21 | # listboxSelection - All of the items that were selected before the | |
22 | # current selection operation (such as a mouse | |
23 | # drag) started; used to cancel an operation. | |
24 | #-------------------------------------------------------------------------- | |
25 | ||
26 | #------------------------------------------------------------------------- | |
27 | # The code below creates the default class bindings for listboxes. | |
28 | #------------------------------------------------------------------------- | |
29 | ||
30 | # Note: the check for existence of %W below is because this binding | |
31 | # is sometimes invoked after a window has been deleted (e.g. because | |
32 | # there is a double-click binding on the widget that deletes it). Users | |
33 | # can put "break"s in their bindings to avoid the error, but this check | |
34 | # makes that unnecessary. | |
35 | ||
36 | bind Listbox <1> { | |
37 | if {[winfo exists %W]} { | |
38 | tk::ListboxBeginSelect %W [%W index @%x,%y] | |
39 | } | |
40 | } | |
41 | ||
42 | # Ignore double clicks so that users can define their own behaviors. | |
43 | # Among other things, this prevents errors if the user deletes the | |
44 | # listbox on a double click. | |
45 | ||
46 | bind Listbox <Double-1> { | |
47 | # Empty script | |
48 | } | |
49 | ||
50 | bind Listbox <B1-Motion> { | |
51 | set tk::Priv(x) %x | |
52 | set tk::Priv(y) %y | |
53 | tk::ListboxMotion %W [%W index @%x,%y] | |
54 | } | |
55 | bind Listbox <ButtonRelease-1> { | |
56 | tk::CancelRepeat | |
57 | %W activate @%x,%y | |
58 | } | |
59 | bind Listbox <Shift-1> { | |
60 | tk::ListboxBeginExtend %W [%W index @%x,%y] | |
61 | } | |
62 | bind Listbox <Control-1> { | |
63 | tk::ListboxBeginToggle %W [%W index @%x,%y] | |
64 | } | |
65 | bind Listbox <B1-Leave> { | |
66 | set tk::Priv(x) %x | |
67 | set tk::Priv(y) %y | |
68 | tk::ListboxAutoScan %W | |
69 | } | |
70 | bind Listbox <B1-Enter> { | |
71 | tk::CancelRepeat | |
72 | } | |
73 | ||
74 | bind Listbox <Up> { | |
75 | tk::ListboxUpDown %W -1 | |
76 | } | |
77 | bind Listbox <Shift-Up> { | |
78 | tk::ListboxExtendUpDown %W -1 | |
79 | } | |
80 | bind Listbox <Down> { | |
81 | tk::ListboxUpDown %W 1 | |
82 | } | |
83 | bind Listbox <Shift-Down> { | |
84 | tk::ListboxExtendUpDown %W 1 | |
85 | } | |
86 | bind Listbox <Left> { | |
87 | %W xview scroll -1 units | |
88 | } | |
89 | bind Listbox <Control-Left> { | |
90 | %W xview scroll -1 pages | |
91 | } | |
92 | bind Listbox <Right> { | |
93 | %W xview scroll 1 units | |
94 | } | |
95 | bind Listbox <Control-Right> { | |
96 | %W xview scroll 1 pages | |
97 | } | |
98 | bind Listbox <Prior> { | |
99 | %W yview scroll -1 pages | |
100 | %W activate @0,0 | |
101 | } | |
102 | bind Listbox <Next> { | |
103 | %W yview scroll 1 pages | |
104 | %W activate @0,0 | |
105 | } | |
106 | bind Listbox <Control-Prior> { | |
107 | %W xview scroll -1 pages | |
108 | } | |
109 | bind Listbox <Control-Next> { | |
110 | %W xview scroll 1 pages | |
111 | } | |
112 | bind Listbox <Home> { | |
113 | %W xview moveto 0 | |
114 | } | |
115 | bind Listbox <End> { | |
116 | %W xview moveto 1 | |
117 | } | |
118 | bind Listbox <Control-Home> { | |
119 | %W activate 0 | |
120 | %W see 0 | |
121 | %W selection clear 0 end | |
122 | %W selection set 0 | |
123 | event generate %W <<ListboxSelect>> | |
124 | } | |
125 | bind Listbox <Shift-Control-Home> { | |
126 | tk::ListboxDataExtend %W 0 | |
127 | } | |
128 | bind Listbox <Control-End> { | |
129 | %W activate end | |
130 | %W see end | |
131 | %W selection clear 0 end | |
132 | %W selection set end | |
133 | event generate %W <<ListboxSelect>> | |
134 | } | |
135 | bind Listbox <Shift-Control-End> { | |
136 | tk::ListboxDataExtend %W [%W index end] | |
137 | } | |
138 | bind Listbox <<Copy>> { | |
139 | if {[string equal [selection own -displayof %W] "%W"]} { | |
140 | clipboard clear -displayof %W | |
141 | clipboard append -displayof %W [selection get -displayof %W] | |
142 | } | |
143 | } | |
144 | bind Listbox <space> { | |
145 | tk::ListboxBeginSelect %W [%W index active] | |
146 | } | |
147 | bind Listbox <Select> { | |
148 | tk::ListboxBeginSelect %W [%W index active] | |
149 | } | |
150 | bind Listbox <Control-Shift-space> { | |
151 | tk::ListboxBeginExtend %W [%W index active] | |
152 | } | |
153 | bind Listbox <Shift-Select> { | |
154 | tk::ListboxBeginExtend %W [%W index active] | |
155 | } | |
156 | bind Listbox <Escape> { | |
157 | tk::ListboxCancel %W | |
158 | } | |
159 | bind Listbox <Control-slash> { | |
160 | tk::ListboxSelectAll %W | |
161 | } | |
162 | bind Listbox <Control-backslash> { | |
163 | if {[string compare [%W cget -selectmode] "browse"]} { | |
164 | %W selection clear 0 end | |
165 | event generate %W <<ListboxSelect>> | |
166 | } | |
167 | } | |
168 | ||
169 | # Additional Tk bindings that aren't part of the Motif look and feel: | |
170 | ||
171 | bind Listbox <2> { | |
172 | %W scan mark %x %y | |
173 | } | |
174 | bind Listbox <B2-Motion> { | |
175 | %W scan dragto %x %y | |
176 | } | |
177 | ||
178 | # The MouseWheel will typically only fire on Windows. However, | |
179 | # someone could use the "event generate" command to produce one | |
180 | # on other platforms. | |
181 | ||
182 | if {[string equal [tk windowingsystem] "classic"] | |
183 | || [string equal [tk windowingsystem] "aqua"]} { | |
184 | bind Listbox <MouseWheel> { | |
185 | %W yview scroll [expr {- (%D)}] units | |
186 | } | |
187 | bind Listbox <Option-MouseWheel> { | |
188 | %W yview scroll [expr {-10 * (%D)}] units | |
189 | } | |
190 | bind Listbox <Shift-MouseWheel> { | |
191 | %W xview scroll [expr {- (%D)}] units | |
192 | } | |
193 | bind Listbox <Shift-Option-MouseWheel> { | |
194 | %W xview scroll [expr {-10 * (%D)}] units | |
195 | } | |
196 | } else { | |
197 | bind Listbox <MouseWheel> { | |
198 | %W yview scroll [expr {- (%D / 120) * 4}] units | |
199 | } | |
200 | } | |
201 | ||
202 | if {[string equal "x11" [tk windowingsystem]]} { | |
203 | # Support for mousewheels on Linux/Unix commonly comes through mapping | |
204 | # the wheel to the extended buttons. If you have a mousewheel, find | |
205 | # Linux configuration info at: | |
206 | # http://www.inria.fr/koala/colas/mouse-wheel-scroll/ | |
207 | bind Listbox <4> { | |
208 | if {!$tk_strictMotif} { | |
209 | %W yview scroll -5 units | |
210 | } | |
211 | } | |
212 | bind Listbox <5> { | |
213 | if {!$tk_strictMotif} { | |
214 | %W yview scroll 5 units | |
215 | } | |
216 | } | |
217 | } | |
218 | ||
219 | # ::tk::ListboxBeginSelect -- | |
220 | # | |
221 | # This procedure is typically invoked on button-1 presses. It begins | |
222 | # the process of making a selection in the listbox. Its exact behavior | |
223 | # depends on the selection mode currently in effect for the listbox; | |
224 | # see the Motif documentation for details. | |
225 | # | |
226 | # Arguments: | |
227 | # w - The listbox widget. | |
228 | # el - The element for the selection operation (typically the | |
229 | # one under the pointer). Must be in numerical form. | |
230 | ||
231 | proc ::tk::ListboxBeginSelect {w el} { | |
232 | variable ::tk::Priv | |
233 | if {[string equal [$w cget -selectmode] "multiple"]} { | |
234 | if {[$w selection includes $el]} { | |
235 | $w selection clear $el | |
236 | } else { | |
237 | $w selection set $el | |
238 | } | |
239 | } else { | |
240 | $w selection clear 0 end | |
241 | $w selection set $el | |
242 | $w selection anchor $el | |
243 | set Priv(listboxSelection) {} | |
244 | set Priv(listboxPrev) $el | |
245 | } | |
246 | event generate $w <<ListboxSelect>> | |
247 | } | |
248 | ||
249 | # ::tk::ListboxMotion -- | |
250 | # | |
251 | # This procedure is called to process mouse motion events while | |
252 | # button 1 is down. It may move or extend the selection, depending | |
253 | # on the listbox's selection mode. | |
254 | # | |
255 | # Arguments: | |
256 | # w - The listbox widget. | |
257 | # el - The element under the pointer (must be a number). | |
258 | ||
259 | proc ::tk::ListboxMotion {w el} { | |
260 | variable ::tk::Priv | |
261 | if {$el == $Priv(listboxPrev)} { | |
262 | return | |
263 | } | |
264 | set anchor [$w index anchor] | |
265 | switch [$w cget -selectmode] { | |
266 | browse { | |
267 | $w selection clear 0 end | |
268 | $w selection set $el | |
269 | set Priv(listboxPrev) $el | |
270 | event generate $w <<ListboxSelect>> | |
271 | } | |
272 | extended { | |
273 | set i $Priv(listboxPrev) | |
274 | if {[string equal {} $i]} { | |
275 | set i $el | |
276 | $w selection set $el | |
277 | } | |
278 | if {[$w selection includes anchor]} { | |
279 | $w selection clear $i $el | |
280 | $w selection set anchor $el | |
281 | } else { | |
282 | $w selection clear $i $el | |
283 | $w selection clear anchor $el | |
284 | } | |
285 | if {![info exists Priv(listboxSelection)]} { | |
286 | set Priv(listboxSelection) [$w curselection] | |
287 | } | |
288 | while {($i < $el) && ($i < $anchor)} { | |
289 | if {[lsearch $Priv(listboxSelection) $i] >= 0} { | |
290 | $w selection set $i | |
291 | } | |
292 | incr i | |
293 | } | |
294 | while {($i > $el) && ($i > $anchor)} { | |
295 | if {[lsearch $Priv(listboxSelection) $i] >= 0} { | |
296 | $w selection set $i | |
297 | } | |
298 | incr i -1 | |
299 | } | |
300 | set Priv(listboxPrev) $el | |
301 | event generate $w <<ListboxSelect>> | |
302 | } | |
303 | } | |
304 | } | |
305 | ||
306 | # ::tk::ListboxBeginExtend -- | |
307 | # | |
308 | # This procedure is typically invoked on shift-button-1 presses. It | |
309 | # begins the process of extending a selection in the listbox. Its | |
310 | # exact behavior depends on the selection mode currently in effect | |
311 | # for the listbox; see the Motif documentation for details. | |
312 | # | |
313 | # Arguments: | |
314 | # w - The listbox widget. | |
315 | # el - The element for the selection operation (typically the | |
316 | # one under the pointer). Must be in numerical form. | |
317 | ||
318 | proc ::tk::ListboxBeginExtend {w el} { | |
319 | if {[string equal [$w cget -selectmode] "extended"]} { | |
320 | if {[$w selection includes anchor]} { | |
321 | ListboxMotion $w $el | |
322 | } else { | |
323 | # No selection yet; simulate the begin-select operation. | |
324 | ListboxBeginSelect $w $el | |
325 | } | |
326 | } | |
327 | } | |
328 | ||
329 | # ::tk::ListboxBeginToggle -- | |
330 | # | |
331 | # This procedure is typically invoked on control-button-1 presses. It | |
332 | # begins the process of toggling a selection in the listbox. Its | |
333 | # exact behavior depends on the selection mode currently in effect | |
334 | # for the listbox; see the Motif documentation for details. | |
335 | # | |
336 | # Arguments: | |
337 | # w - The listbox widget. | |
338 | # el - The element for the selection operation (typically the | |
339 | # one under the pointer). Must be in numerical form. | |
340 | ||
341 | proc ::tk::ListboxBeginToggle {w el} { | |
342 | variable ::tk::Priv | |
343 | if {[string equal [$w cget -selectmode] "extended"]} { | |
344 | set Priv(listboxSelection) [$w curselection] | |
345 | set Priv(listboxPrev) $el | |
346 | $w selection anchor $el | |
347 | if {[$w selection includes $el]} { | |
348 | $w selection clear $el | |
349 | } else { | |
350 | $w selection set $el | |
351 | } | |
352 | event generate $w <<ListboxSelect>> | |
353 | } | |
354 | } | |
355 | ||
356 | # ::tk::ListboxAutoScan -- | |
357 | # This procedure is invoked when the mouse leaves an entry window | |
358 | # with button 1 down. It scrolls the window up, down, left, or | |
359 | # right, depending on where the mouse left the window, and reschedules | |
360 | # itself as an "after" command so that the window continues to scroll until | |
361 | # the mouse moves back into the window or the mouse button is released. | |
362 | # | |
363 | # Arguments: | |
364 | # w - The entry window. | |
365 | ||
366 | proc ::tk::ListboxAutoScan {w} { | |
367 | variable ::tk::Priv | |
368 | if {![winfo exists $w]} return | |
369 | set x $Priv(x) | |
370 | set y $Priv(y) | |
371 | if {$y >= [winfo height $w]} { | |
372 | $w yview scroll 1 units | |
373 | } elseif {$y < 0} { | |
374 | $w yview scroll -1 units | |
375 | } elseif {$x >= [winfo width $w]} { | |
376 | $w xview scroll 2 units | |
377 | } elseif {$x < 0} { | |
378 | $w xview scroll -2 units | |
379 | } else { | |
380 | return | |
381 | } | |
382 | ListboxMotion $w [$w index @$x,$y] | |
383 | set Priv(afterId) [after 50 [list tk::ListboxAutoScan $w]] | |
384 | } | |
385 | ||
386 | # ::tk::ListboxUpDown -- | |
387 | # | |
388 | # Moves the location cursor (active element) up or down by one element, | |
389 | # and changes the selection if we're in browse or extended selection | |
390 | # mode. | |
391 | # | |
392 | # Arguments: | |
393 | # w - The listbox widget. | |
394 | # amount - +1 to move down one item, -1 to move back one item. | |
395 | ||
396 | proc ::tk::ListboxUpDown {w amount} { | |
397 | variable ::tk::Priv | |
398 | $w activate [expr {[$w index active] + $amount}] | |
399 | $w see active | |
400 | switch [$w cget -selectmode] { | |
401 | browse { | |
402 | $w selection clear 0 end | |
403 | $w selection set active | |
404 | event generate $w <<ListboxSelect>> | |
405 | } | |
406 | extended { | |
407 | $w selection clear 0 end | |
408 | $w selection set active | |
409 | $w selection anchor active | |
410 | set Priv(listboxPrev) [$w index active] | |
411 | set Priv(listboxSelection) {} | |
412 | event generate $w <<ListboxSelect>> | |
413 | } | |
414 | } | |
415 | } | |
416 | ||
417 | # ::tk::ListboxExtendUpDown -- | |
418 | # | |
419 | # Does nothing unless we're in extended selection mode; in this | |
420 | # case it moves the location cursor (active element) up or down by | |
421 | # one element, and extends the selection to that point. | |
422 | # | |
423 | # Arguments: | |
424 | # w - The listbox widget. | |
425 | # amount - +1 to move down one item, -1 to move back one item. | |
426 | ||
427 | proc ::tk::ListboxExtendUpDown {w amount} { | |
428 | variable ::tk::Priv | |
429 | if {[string compare [$w cget -selectmode] "extended"]} { | |
430 | return | |
431 | } | |
432 | set active [$w index active] | |
433 | if {![info exists Priv(listboxSelection)]} { | |
434 | $w selection set $active | |
435 | set Priv(listboxSelection) [$w curselection] | |
436 | } | |
437 | $w activate [expr {$active + $amount}] | |
438 | $w see active | |
439 | ListboxMotion $w [$w index active] | |
440 | } | |
441 | ||
442 | # ::tk::ListboxDataExtend | |
443 | # | |
444 | # This procedure is called for key-presses such as Shift-KEndData. | |
445 | # If the selection mode isn't multiple or extend then it does nothing. | |
446 | # Otherwise it moves the active element to el and, if we're in | |
447 | # extended mode, extends the selection to that point. | |
448 | # | |
449 | # Arguments: | |
450 | # w - The listbox widget. | |
451 | # el - An integer element number. | |
452 | ||
453 | proc ::tk::ListboxDataExtend {w el} { | |
454 | set mode [$w cget -selectmode] | |
455 | if {[string equal $mode "extended"]} { | |
456 | $w activate $el | |
457 | $w see $el | |
458 | if {[$w selection includes anchor]} { | |
459 | ListboxMotion $w $el | |
460 | } | |
461 | } elseif {[string equal $mode "multiple"]} { | |
462 | $w activate $el | |
463 | $w see $el | |
464 | } | |
465 | } | |
466 | ||
467 | # ::tk::ListboxCancel | |
468 | # | |
469 | # This procedure is invoked to cancel an extended selection in | |
470 | # progress. If there is an extended selection in progress, it | |
471 | # restores all of the items between the active one and the anchor | |
472 | # to their previous selection state. | |
473 | # | |
474 | # Arguments: | |
475 | # w - The listbox widget. | |
476 | ||
477 | proc ::tk::ListboxCancel w { | |
478 | variable ::tk::Priv | |
479 | if {[string compare [$w cget -selectmode] "extended"]} { | |
480 | return | |
481 | } | |
482 | set first [$w index anchor] | |
483 | set last $Priv(listboxPrev) | |
484 | if { [string equal $last ""] } { | |
485 | # Not actually doing any selection right now | |
486 | return | |
487 | } | |
488 | if {$first > $last} { | |
489 | set tmp $first | |
490 | set first $last | |
491 | set last $tmp | |
492 | } | |
493 | $w selection clear $first $last | |
494 | while {$first <= $last} { | |
495 | if {[lsearch $Priv(listboxSelection) $first] >= 0} { | |
496 | $w selection set $first | |
497 | } | |
498 | incr first | |
499 | } | |
500 | event generate $w <<ListboxSelect>> | |
501 | } | |
502 | ||
503 | # ::tk::ListboxSelectAll | |
504 | # | |
505 | # This procedure is invoked to handle the "select all" operation. | |
506 | # For single and browse mode, it just selects the active element. | |
507 | # Otherwise it selects everything in the widget. | |
508 | # | |
509 | # Arguments: | |
510 | # w - The listbox widget. | |
511 | ||
512 | proc ::tk::ListboxSelectAll w { | |
513 | set mode [$w cget -selectmode] | |
514 | if {[string equal $mode "single"] || [string equal $mode "browse"]} { | |
515 | $w selection clear 0 end | |
516 | $w selection set active | |
517 | } else { | |
518 | $w selection set 0 end | |
519 | } | |
520 | event generate $w <<ListboxSelect>> | |
521 | } |