3 # This file defines the default bindings for Tk listbox widgets
4 # and provides procedures that help in implementing those bindings.
6 # RCS: @(#) $Id: listbox.tcl,v 1.15 2005/09/10 14:53:20 das Exp $
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.
12 # See the file "license.terms" for information on usage and redistribution
13 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
15 #--------------------------------------------------------------------------
16 # tk::Priv elements used in this file:
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 #--------------------------------------------------------------------------
26 #-------------------------------------------------------------------------
27 # The code below creates the default class bindings for listboxes.
28 #-------------------------------------------------------------------------
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.
37 if {[winfo exists
%W
]} {
38 tk::ListboxBeginSelect %W
[%W index
@%x
,%y
]
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.
46 bind Listbox
<Double-1
> {
50 bind Listbox
<B1-Motion
> {
53 tk::ListboxMotion %W
[%W index
@%x
,%y
]
55 bind Listbox
<ButtonRelease-1
> {
59 bind Listbox
<Shift-1
> {
60 tk::ListboxBeginExtend %W
[%W index
@%x
,%y
]
62 bind Listbox
<Control-1
> {
63 tk::ListboxBeginToggle %W
[%W index
@%x
,%y
]
65 bind Listbox
<B1-Leave
> {
68 tk::ListboxAutoScan %W
70 bind Listbox
<B1-Enter
> {
75 tk::ListboxUpDown %W
-1
77 bind Listbox
<Shift-Up
> {
78 tk::ListboxExtendUpDown %W
-1
81 tk::ListboxUpDown %W
1
83 bind Listbox
<Shift-Down
> {
84 tk::ListboxExtendUpDown %W
1
87 %W xview scroll
-1 units
89 bind Listbox
<Control-Left
> {
90 %W xview scroll
-1 pages
92 bind Listbox
<Right
> {
93 %W xview scroll
1 units
95 bind Listbox
<Control-Right
> {
96 %W xview scroll
1 pages
98 bind Listbox
<Prior
> {
99 %W yview scroll
-1 pages
102 bind Listbox
<Next
> {
103 %W yview scroll
1 pages
106 bind Listbox
<Control-Prior
> {
107 %W xview scroll
-1 pages
109 bind Listbox
<Control-Next
> {
110 %W xview scroll
1 pages
112 bind Listbox
<Home
> {
118 bind Listbox
<Control-Home
> {
121 %W
selection clear
0 end
123 event generate
%W
<<ListboxSelect
>>
125 bind Listbox
<Shift-Control-Home
> {
126 tk::ListboxDataExtend %W
0
128 bind Listbox
<Control-End
> {
131 %W
selection clear
0 end
133 event generate
%W
<<ListboxSelect
>>
135 bind Listbox
<Shift-Control-End
> {
136 tk::ListboxDataExtend %W
[%W index end
]
138 bind Listbox
<<Copy
>> {
139 if {[selection own
-displayof %W
] eq
"%W"} {
140 clipboard clear
-displayof %W
141 clipboard append -displayof %W
[selection get
-displayof %W
]
144 bind Listbox
<space
> {
145 tk::ListboxBeginSelect %W
[%W index active
]
147 bind Listbox
<Select
> {
148 tk::ListboxBeginSelect %W
[%W index active
]
150 bind Listbox
<Control-Shift-space
> {
151 tk::ListboxBeginExtend %W
[%W index active
]
153 bind Listbox
<Shift-Select
> {
154 tk::ListboxBeginExtend %W
[%W index active
]
156 bind Listbox
<Escape
> {
159 bind Listbox
<Control-slash
> {
160 tk::ListboxSelectAll %W
162 bind Listbox
<Control-backslash
> {
163 if {[%W cget
-selectmode] ne
"browse"} {
164 %W
selection clear
0 end
165 event generate
%W
<<ListboxSelect
>>
169 # Additional Tk bindings that aren't part of the Motif look and feel:
174 bind Listbox
<B2-Motion
> {
178 # The MouseWheel will typically only fire on Windows and Mac OS X.
179 # However, someone could use the "event generate" command to produce
180 # one on other platforms.
182 if {[tk windowingsystem
] eq
"aqua"} {
183 bind Listbox
<MouseWheel
> {
184 %W yview scroll
[expr {- (%D
)}] units
186 bind Listbox
<Option-MouseWheel
> {
187 %W yview scroll
[expr {-10 * (%D
)}] units
189 bind Listbox
<Shift-MouseWheel
> {
190 %W xview scroll
[expr {- (%D
)}] units
192 bind Listbox
<Shift-Option-MouseWheel
> {
193 %W xview scroll
[expr {-10 * (%D
)}] units
196 bind Listbox
<MouseWheel
> {
197 %W yview scroll
[expr {- (%D
/ 120) * 4}] units
201 if {"x11" eq
[tk windowingsystem
]} {
202 # Support for mousewheels on Linux/Unix commonly comes through mapping
203 # the wheel to the extended buttons. If you have a mousewheel, find
204 # Linux configuration info at:
205 # http://www.inria.fr/koala/colas/mouse-wheel-scroll/
207 if {!$tk_strictMotif} {
208 %W yview scroll
-5 units
212 if {!$tk_strictMotif} {
213 %W yview scroll
5 units
218 # ::tk::ListboxBeginSelect --
220 # This procedure is typically invoked on button-1 presses. It begins
221 # the process of making a selection in the listbox. Its exact behavior
222 # depends on the selection mode currently in effect for the listbox;
223 # see the Motif documentation for details.
226 # w - The listbox widget.
227 # el - The element for the selection operation (typically the
228 # one under the pointer). Must be in numerical form.
230 proc ::tk::ListboxBeginSelect {w el
} {
232 if {[$w cget
-selectmode] eq
"multiple"} {
233 if {[$w selection includes
$el]} {
234 $w selection clear
$el
239 $w selection clear
0 end
241 $w selection anchor
$el
242 set Priv
(listboxSelection
) {}
243 set Priv
(listboxPrev
) $el
245 event generate
$w <<ListboxSelect
>>
248 # ::tk::ListboxMotion --
250 # This procedure is called to process mouse motion events while
251 # button 1 is down. It may move or extend the selection, depending
252 # on the listbox's selection mode.
255 # w - The listbox widget.
256 # el - The element under the pointer (must be a number).
258 proc ::tk::ListboxMotion {w el
} {
260 if {$el == $Priv(listboxPrev
)} {
263 set anchor
[$w index anchor
]
264 switch [$w cget
-selectmode] {
266 $w selection clear
0 end
268 set Priv
(listboxPrev
) $el
269 event generate
$w <<ListboxSelect
>>
272 set i
$Priv(listboxPrev
)
277 if {[$w selection includes anchor
]} {
278 $w selection clear
$i $el
279 $w selection set anchor
$el
281 $w selection clear
$i $el
282 $w selection clear anchor
$el
284 if {![info exists Priv
(listboxSelection
)]} {
285 set Priv
(listboxSelection
) [$w curselection
]
287 while {($i < $el) && ($i < $anchor)} {
288 if {[lsearch $Priv(listboxSelection
) $i] >= 0} {
293 while {($i > $el) && ($i > $anchor)} {
294 if {[lsearch $Priv(listboxSelection
) $i] >= 0} {
299 set Priv
(listboxPrev
) $el
300 event generate
$w <<ListboxSelect
>>
305 # ::tk::ListboxBeginExtend --
307 # This procedure is typically invoked on shift-button-1 presses. It
308 # begins the process of extending a selection in the listbox. Its
309 # exact behavior depends on the selection mode currently in effect
310 # for the listbox; see the Motif documentation for details.
313 # w - The listbox widget.
314 # el - The element for the selection operation (typically the
315 # one under the pointer). Must be in numerical form.
317 proc ::tk::ListboxBeginExtend {w el
} {
318 if {[$w cget
-selectmode] eq
"extended"} {
319 if {[$w selection includes anchor
]} {
322 # No selection yet; simulate the begin-select operation.
323 ListboxBeginSelect
$w $el
328 # ::tk::ListboxBeginToggle --
330 # This procedure is typically invoked on control-button-1 presses. It
331 # begins the process of toggling a selection in the listbox. Its
332 # exact behavior depends on the selection mode currently in effect
333 # for the listbox; see the Motif documentation for details.
336 # w - The listbox widget.
337 # el - The element for the selection operation (typically the
338 # one under the pointer). Must be in numerical form.
340 proc ::tk::ListboxBeginToggle {w el
} {
342 if {[$w cget
-selectmode] eq
"extended"} {
343 set Priv
(listboxSelection
) [$w curselection
]
344 set Priv
(listboxPrev
) $el
345 $w selection anchor
$el
346 if {[$w selection includes
$el]} {
347 $w selection clear
$el
351 event generate
$w <<ListboxSelect
>>
355 # ::tk::ListboxAutoScan --
356 # This procedure is invoked when the mouse leaves an entry window
357 # with button 1 down. It scrolls the window up, down, left, or
358 # right, depending on where the mouse left the window, and reschedules
359 # itself as an "after" command so that the window continues to scroll until
360 # the mouse moves back into the window or the mouse button is released.
363 # w - The entry window.
365 proc ::tk::ListboxAutoScan {w
} {
367 if {![winfo exists
$w]} return
370 if {$y >= [winfo height
$w]} {
371 $w yview scroll
1 units
373 $w yview scroll
-1 units
374 } elseif
{$x >= [winfo width
$w]} {
375 $w xview scroll
2 units
377 $w xview scroll
-2 units
381 ListboxMotion
$w [$w index
@$x,$y]
382 set Priv
(afterId
) [after 50 [list tk::ListboxAutoScan $w]]
385 # ::tk::ListboxUpDown --
387 # Moves the location cursor (active element) up or down by one element,
388 # and changes the selection if we're in browse or extended selection
392 # w - The listbox widget.
393 # amount - +1 to move down one item, -1 to move back one item.
395 proc ::tk::ListboxUpDown {w amount
} {
397 $w activate
[expr {[$w index active
] + $amount}]
399 switch [$w cget
-selectmode] {
401 $w selection clear
0 end
402 $w selection set active
403 event generate
$w <<ListboxSelect
>>
406 $w selection clear
0 end
407 $w selection set active
408 $w selection anchor active
409 set Priv
(listboxPrev
) [$w index active
]
410 set Priv
(listboxSelection
) {}
411 event generate
$w <<ListboxSelect
>>
416 # ::tk::ListboxExtendUpDown --
418 # Does nothing unless we're in extended selection mode; in this
419 # case it moves the location cursor (active element) up or down by
420 # one element, and extends the selection to that point.
423 # w - The listbox widget.
424 # amount - +1 to move down one item, -1 to move back one item.
426 proc ::tk::ListboxExtendUpDown {w amount
} {
428 if {[$w cget
-selectmode] ne
"extended"} {
431 set active
[$w index active
]
432 if {![info exists Priv
(listboxSelection
)]} {
433 $w selection set $active
434 set Priv
(listboxSelection
) [$w curselection
]
436 $w activate
[expr {$active + $amount}]
438 ListboxMotion
$w [$w index active
]
441 # ::tk::ListboxDataExtend
443 # This procedure is called for key-presses such as Shift-KEndData.
444 # If the selection mode isn't multiple or extend then it does nothing.
445 # Otherwise it moves the active element to el and, if we're in
446 # extended mode, extends the selection to that point.
449 # w - The listbox widget.
450 # el - An integer element number.
452 proc ::tk::ListboxDataExtend {w el
} {
453 set mode
[$w cget
-selectmode]
454 if {$mode eq
"extended"} {
457 if {[$w selection includes anchor
]} {
460 } elseif
{$mode eq
"multiple"} {
466 # ::tk::ListboxCancel
468 # This procedure is invoked to cancel an extended selection in
469 # progress. If there is an extended selection in progress, it
470 # restores all of the items between the active one and the anchor
471 # to their previous selection state.
474 # w - The listbox widget.
476 proc ::tk::ListboxCancel w
{
478 if {[$w cget
-selectmode] ne
"extended"} {
481 set first
[$w index anchor
]
482 set last
$Priv(listboxPrev
)
484 # Not actually doing any selection right now
487 if {$first > $last} {
492 $w selection clear
$first $last
493 while {$first <= $last} {
494 if {[lsearch $Priv(listboxSelection
) $first] >= 0} {
495 $w selection set $first
499 event generate
$w <<ListboxSelect
>>
502 # ::tk::ListboxSelectAll
504 # This procedure is invoked to handle the "select all" operation.
505 # For single and browse mode, it just selects the active element.
506 # Otherwise it selects everything in the widget.
509 # w - The listbox widget.
511 proc ::tk::ListboxSelectAll w
{
512 set mode
[$w cget
-selectmode]
513 if {$mode eq
"single" ||
$mode eq
"browse"} {
514 $w selection clear
0 end
515 $w selection set active
517 $w selection set 0 end
519 event generate
$w <<ListboxSelect
>>