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.18 2007/12/13 15:26:27 dgp 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
] 1
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
{focus 1}} {
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
>>
246 # check existence as ListboxSelect may destroy us
247 if {$focus && [winfo exists
$w] && [$w cget
-state] eq
"normal"} {
252 # ::tk::ListboxMotion --
254 # This procedure is called to process mouse motion events while
255 # button 1 is down. It may move or extend the selection, depending
256 # on the listbox's selection mode.
259 # w - The listbox widget.
260 # el - The element under the pointer (must be a number).
262 proc ::tk::ListboxMotion {w el
} {
264 if {$el == $Priv(listboxPrev
)} {
267 set anchor
[$w index anchor
]
268 switch [$w cget
-selectmode] {
270 $w selection clear
0 end
272 set Priv
(listboxPrev
) $el
273 event generate
$w <<ListboxSelect
>>
276 set i
$Priv(listboxPrev
)
281 if {[$w selection includes anchor
]} {
282 $w selection clear
$i $el
283 $w selection set anchor
$el
285 $w selection clear
$i $el
286 $w selection clear anchor
$el
288 if {![info exists Priv
(listboxSelection
)]} {
289 set Priv
(listboxSelection
) [$w curselection
]
291 while {($i < $el) && ($i < $anchor)} {
292 if {[lsearch $Priv(listboxSelection
) $i] >= 0} {
297 while {($i > $el) && ($i > $anchor)} {
298 if {[lsearch $Priv(listboxSelection
) $i] >= 0} {
303 set Priv
(listboxPrev
) $el
304 event generate
$w <<ListboxSelect
>>
309 # ::tk::ListboxBeginExtend --
311 # This procedure is typically invoked on shift-button-1 presses. It
312 # begins the process of extending a selection in the listbox. Its
313 # exact behavior depends on the selection mode currently in effect
314 # for the listbox; see the Motif documentation for details.
317 # w - The listbox widget.
318 # el - The element for the selection operation (typically the
319 # one under the pointer). Must be in numerical form.
321 proc ::tk::ListboxBeginExtend {w el
} {
322 if {[$w cget
-selectmode] eq
"extended"} {
323 if {[$w selection includes anchor
]} {
326 # No selection yet; simulate the begin-select operation.
327 ListboxBeginSelect
$w $el
332 # ::tk::ListboxBeginToggle --
334 # This procedure is typically invoked on control-button-1 presses. It
335 # begins the process of toggling a selection in the listbox. Its
336 # exact behavior depends on the selection mode currently in effect
337 # for the listbox; see the Motif documentation for details.
340 # w - The listbox widget.
341 # el - The element for the selection operation (typically the
342 # one under the pointer). Must be in numerical form.
344 proc ::tk::ListboxBeginToggle {w el
} {
346 if {[$w cget
-selectmode] eq
"extended"} {
347 set Priv
(listboxSelection
) [$w curselection
]
348 set Priv
(listboxPrev
) $el
349 $w selection anchor
$el
350 if {[$w selection includes
$el]} {
351 $w selection clear
$el
355 event generate
$w <<ListboxSelect
>>
359 # ::tk::ListboxAutoScan --
360 # This procedure is invoked when the mouse leaves an entry window
361 # with button 1 down. It scrolls the window up, down, left, or
362 # right, depending on where the mouse left the window, and reschedules
363 # itself as an "after" command so that the window continues to scroll until
364 # the mouse moves back into the window or the mouse button is released.
367 # w - The entry window.
369 proc ::tk::ListboxAutoScan {w
} {
371 if {![winfo exists
$w]} return
374 if {$y >= [winfo height
$w]} {
375 $w yview scroll
1 units
377 $w yview scroll
-1 units
378 } elseif
{$x >= [winfo width
$w]} {
379 $w xview scroll
2 units
381 $w xview scroll
-2 units
385 ListboxMotion
$w [$w index
@$x,$y]
386 set Priv
(afterId
) [after 50 [list tk::ListboxAutoScan $w]]
389 # ::tk::ListboxUpDown --
391 # Moves the location cursor (active element) up or down by one element,
392 # and changes the selection if we're in browse or extended selection
396 # w - The listbox widget.
397 # amount - +1 to move down one item, -1 to move back one item.
399 proc ::tk::ListboxUpDown {w amount
} {
401 $w activate
[expr {[$w index active
] + $amount}]
403 switch [$w cget
-selectmode] {
405 $w selection clear
0 end
406 $w selection set active
407 event generate
$w <<ListboxSelect
>>
410 $w selection clear
0 end
411 $w selection set active
412 $w selection anchor active
413 set Priv
(listboxPrev
) [$w index active
]
414 set Priv
(listboxSelection
) {}
415 event generate
$w <<ListboxSelect
>>
420 # ::tk::ListboxExtendUpDown --
422 # Does nothing unless we're in extended selection mode; in this
423 # case it moves the location cursor (active element) up or down by
424 # one element, and extends the selection to that point.
427 # w - The listbox widget.
428 # amount - +1 to move down one item, -1 to move back one item.
430 proc ::tk::ListboxExtendUpDown {w amount
} {
432 if {[$w cget
-selectmode] ne
"extended"} {
435 set active
[$w index active
]
436 if {![info exists Priv
(listboxSelection
)]} {
437 $w selection set $active
438 set Priv
(listboxSelection
) [$w curselection
]
440 $w activate
[expr {$active + $amount}]
442 ListboxMotion
$w [$w index active
]
445 # ::tk::ListboxDataExtend
447 # This procedure is called for key-presses such as Shift-KEndData.
448 # If the selection mode isn't multiple or extend then it does nothing.
449 # Otherwise it moves the active element to el and, if we're in
450 # extended mode, extends the selection to that point.
453 # w - The listbox widget.
454 # el - An integer element number.
456 proc ::tk::ListboxDataExtend {w el
} {
457 set mode
[$w cget
-selectmode]
458 if {$mode eq
"extended"} {
461 if {[$w selection includes anchor
]} {
464 } elseif
{$mode eq
"multiple"} {
470 # ::tk::ListboxCancel
472 # This procedure is invoked to cancel an extended selection in
473 # progress. If there is an extended selection in progress, it
474 # restores all of the items between the active one and the anchor
475 # to their previous selection state.
478 # w - The listbox widget.
480 proc ::tk::ListboxCancel w
{
482 if {[$w cget
-selectmode] ne
"extended"} {
485 set first
[$w index anchor
]
486 set last
$Priv(listboxPrev
)
488 # Not actually doing any selection right now
491 if {$first > $last} {
496 $w selection clear
$first $last
497 while {$first <= $last} {
498 if {[lsearch $Priv(listboxSelection
) $first] >= 0} {
499 $w selection set $first
503 event generate
$w <<ListboxSelect
>>
506 # ::tk::ListboxSelectAll
508 # This procedure is invoked to handle the "select all" operation.
509 # For single and browse mode, it just selects the active element.
510 # Otherwise it selects everything in the widget.
513 # w - The listbox widget.
515 proc ::tk::ListboxSelectAll w
{
516 set mode
[$w cget
-selectmode]
517 if {$mode eq
"single" ||
$mode eq
"browse"} {
518 $w selection clear
0 end
519 $w selection set active
521 $w selection set 0 end
523 event generate
$w <<ListboxSelect
>>