[37] | 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.11 2000/03/24 19:38:57 ericm 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 | # tkPriv 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 | tkListboxBeginSelect %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 tkPriv(x) %x |
---|
| 52 | set tkPriv(y) %y |
---|
| 53 | tkListboxMotion %W [%W index @%x,%y] |
---|
| 54 | } |
---|
| 55 | bind Listbox <ButtonRelease-1> { |
---|
| 56 | tkCancelRepeat |
---|
| 57 | %W activate @%x,%y |
---|
| 58 | } |
---|
| 59 | bind Listbox <Shift-1> { |
---|
| 60 | tkListboxBeginExtend %W [%W index @%x,%y] |
---|
| 61 | } |
---|
| 62 | bind Listbox <Control-1> { |
---|
| 63 | tkListboxBeginToggle %W [%W index @%x,%y] |
---|
| 64 | } |
---|
| 65 | bind Listbox <B1-Leave> { |
---|
| 66 | set tkPriv(x) %x |
---|
| 67 | set tkPriv(y) %y |
---|
| 68 | tkListboxAutoScan %W |
---|
| 69 | } |
---|
| 70 | bind Listbox <B1-Enter> { |
---|
| 71 | tkCancelRepeat |
---|
| 72 | } |
---|
| 73 | |
---|
| 74 | bind Listbox <Up> { |
---|
| 75 | tkListboxUpDown %W -1 |
---|
| 76 | } |
---|
| 77 | bind Listbox <Shift-Up> { |
---|
| 78 | tkListboxExtendUpDown %W -1 |
---|
| 79 | } |
---|
| 80 | bind Listbox <Down> { |
---|
| 81 | tkListboxUpDown %W 1 |
---|
| 82 | } |
---|
| 83 | bind Listbox <Shift-Down> { |
---|
| 84 | tkListboxExtendUpDown %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 | tkListboxDataExtend %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 | tkListboxDataExtend %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 | tkListboxBeginSelect %W [%W index active] |
---|
| 146 | } |
---|
| 147 | bind Listbox <Select> { |
---|
| 148 | tkListboxBeginSelect %W [%W index active] |
---|
| 149 | } |
---|
| 150 | bind Listbox <Control-Shift-space> { |
---|
| 151 | tkListboxBeginExtend %W [%W index active] |
---|
| 152 | } |
---|
| 153 | bind Listbox <Shift-Select> { |
---|
| 154 | tkListboxBeginExtend %W [%W index active] |
---|
| 155 | } |
---|
| 156 | bind Listbox <Escape> { |
---|
| 157 | tkListboxCancel %W |
---|
| 158 | } |
---|
| 159 | bind Listbox <Control-slash> { |
---|
| 160 | tkListboxSelectAll %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 | bind Listbox <MouseWheel> { |
---|
| 183 | %W yview scroll [expr {- (%D / 120) * 4}] units |
---|
| 184 | } |
---|
| 185 | |
---|
| 186 | if {[string equal "unix" $tcl_platform(platform)]} { |
---|
| 187 | # Support for mousewheels on Linux/Unix commonly comes through mapping |
---|
| 188 | # the wheel to the extended buttons. If you have a mousewheel, find |
---|
| 189 | # Linux configuration info at: |
---|
| 190 | # http://www.inria.fr/koala/colas/mouse-wheel-scroll/ |
---|
| 191 | bind Listbox <4> { |
---|
| 192 | if {!$tk_strictMotif} { |
---|
| 193 | %W yview scroll -5 units |
---|
| 194 | } |
---|
| 195 | } |
---|
| 196 | bind Listbox <5> { |
---|
| 197 | if {!$tk_strictMotif} { |
---|
| 198 | %W yview scroll 5 units |
---|
| 199 | } |
---|
| 200 | } |
---|
| 201 | } |
---|
| 202 | |
---|
| 203 | # tkListboxBeginSelect -- |
---|
| 204 | # |
---|
| 205 | # This procedure is typically invoked on button-1 presses. It begins |
---|
| 206 | # the process of making a selection in the listbox. Its exact behavior |
---|
| 207 | # depends on the selection mode currently in effect for the listbox; |
---|
| 208 | # see the Motif documentation for details. |
---|
| 209 | # |
---|
| 210 | # Arguments: |
---|
| 211 | # w - The listbox widget. |
---|
| 212 | # el - The element for the selection operation (typically the |
---|
| 213 | # one under the pointer). Must be in numerical form. |
---|
| 214 | |
---|
| 215 | proc tkListboxBeginSelect {w el} { |
---|
| 216 | global tkPriv |
---|
| 217 | if {[string equal [$w cget -selectmode] "multiple"]} { |
---|
| 218 | if {[$w selection includes $el]} { |
---|
| 219 | $w selection clear $el |
---|
| 220 | } else { |
---|
| 221 | $w selection set $el |
---|
| 222 | } |
---|
| 223 | } else { |
---|
| 224 | $w selection clear 0 end |
---|
| 225 | $w selection set $el |
---|
| 226 | $w selection anchor $el |
---|
| 227 | set tkPriv(listboxSelection) {} |
---|
| 228 | set tkPriv(listboxPrev) $el |
---|
| 229 | } |
---|
| 230 | event generate $w <<ListboxSelect>> |
---|
| 231 | } |
---|
| 232 | |
---|
| 233 | # tkListboxMotion -- |
---|
| 234 | # |
---|
| 235 | # This procedure is called to process mouse motion events while |
---|
| 236 | # button 1 is down. It may move or extend the selection, depending |
---|
| 237 | # on the listbox's selection mode. |
---|
| 238 | # |
---|
| 239 | # Arguments: |
---|
| 240 | # w - The listbox widget. |
---|
| 241 | # el - The element under the pointer (must be a number). |
---|
| 242 | |
---|
| 243 | proc tkListboxMotion {w el} { |
---|
| 244 | global tkPriv |
---|
| 245 | if {$el == $tkPriv(listboxPrev)} { |
---|
| 246 | return |
---|
| 247 | } |
---|
| 248 | set anchor [$w index anchor] |
---|
| 249 | switch [$w cget -selectmode] { |
---|
| 250 | browse { |
---|
| 251 | $w selection clear 0 end |
---|
| 252 | $w selection set $el |
---|
| 253 | set tkPriv(listboxPrev) $el |
---|
| 254 | event generate $w <<ListboxSelect>> |
---|
| 255 | } |
---|
| 256 | extended { |
---|
| 257 | set i $tkPriv(listboxPrev) |
---|
| 258 | if {[string equal {} $i]} { |
---|
| 259 | set i $el |
---|
| 260 | $w selection set $el |
---|
| 261 | } |
---|
| 262 | if {[$w selection includes anchor]} { |
---|
| 263 | $w selection clear $i $el |
---|
| 264 | $w selection set anchor $el |
---|
| 265 | } else { |
---|
| 266 | $w selection clear $i $el |
---|
| 267 | $w selection clear anchor $el |
---|
| 268 | } |
---|
| 269 | if {![info exists tkPriv(listboxSelection)]} { |
---|
| 270 | set tkPriv(listboxSelection) [$w curselection] |
---|
| 271 | } |
---|
| 272 | while {($i < $el) && ($i < $anchor)} { |
---|
| 273 | if {[lsearch $tkPriv(listboxSelection) $i] >= 0} { |
---|
| 274 | $w selection set $i |
---|
| 275 | } |
---|
| 276 | incr i |
---|
| 277 | } |
---|
| 278 | while {($i > $el) && ($i > $anchor)} { |
---|
| 279 | if {[lsearch $tkPriv(listboxSelection) $i] >= 0} { |
---|
| 280 | $w selection set $i |
---|
| 281 | } |
---|
| 282 | incr i -1 |
---|
| 283 | } |
---|
| 284 | set tkPriv(listboxPrev) $el |
---|
| 285 | event generate $w <<ListboxSelect>> |
---|
| 286 | } |
---|
| 287 | } |
---|
| 288 | } |
---|
| 289 | |
---|
| 290 | # tkListboxBeginExtend -- |
---|
| 291 | # |
---|
| 292 | # This procedure is typically invoked on shift-button-1 presses. It |
---|
| 293 | # begins the process of extending a selection in the listbox. Its |
---|
| 294 | # exact behavior depends on the selection mode currently in effect |
---|
| 295 | # for the listbox; see the Motif documentation for details. |
---|
| 296 | # |
---|
| 297 | # Arguments: |
---|
| 298 | # w - The listbox widget. |
---|
| 299 | # el - The element for the selection operation (typically the |
---|
| 300 | # one under the pointer). Must be in numerical form. |
---|
| 301 | |
---|
| 302 | proc tkListboxBeginExtend {w el} { |
---|
| 303 | if {[string equal [$w cget -selectmode] "extended"]} { |
---|
| 304 | if {[$w selection includes anchor]} { |
---|
| 305 | tkListboxMotion $w $el |
---|
| 306 | } else { |
---|
| 307 | # No selection yet; simulate the begin-select operation. |
---|
| 308 | tkListboxBeginSelect $w $el |
---|
| 309 | } |
---|
| 310 | } |
---|
| 311 | } |
---|
| 312 | |
---|
| 313 | # tkListboxBeginToggle -- |
---|
| 314 | # |
---|
| 315 | # This procedure is typically invoked on control-button-1 presses. It |
---|
| 316 | # begins the process of toggling a selection in the listbox. Its |
---|
| 317 | # exact behavior depends on the selection mode currently in effect |
---|
| 318 | # for the listbox; see the Motif documentation for details. |
---|
| 319 | # |
---|
| 320 | # Arguments: |
---|
| 321 | # w - The listbox widget. |
---|
| 322 | # el - The element for the selection operation (typically the |
---|
| 323 | # one under the pointer). Must be in numerical form. |
---|
| 324 | |
---|
| 325 | proc tkListboxBeginToggle {w el} { |
---|
| 326 | global tkPriv |
---|
| 327 | if {[string equal [$w cget -selectmode] "extended"]} { |
---|
| 328 | set tkPriv(listboxSelection) [$w curselection] |
---|
| 329 | set tkPriv(listboxPrev) $el |
---|
| 330 | $w selection anchor $el |
---|
| 331 | if {[$w selection includes $el]} { |
---|
| 332 | $w selection clear $el |
---|
| 333 | } else { |
---|
| 334 | $w selection set $el |
---|
| 335 | } |
---|
| 336 | event generate $w <<ListboxSelect>> |
---|
| 337 | } |
---|
| 338 | } |
---|
| 339 | |
---|
| 340 | # tkListboxAutoScan -- |
---|
| 341 | # This procedure is invoked when the mouse leaves an entry window |
---|
| 342 | # with button 1 down. It scrolls the window up, down, left, or |
---|
| 343 | # right, depending on where the mouse left the window, and reschedules |
---|
| 344 | # itself as an "after" command so that the window continues to scroll until |
---|
| 345 | # the mouse moves back into the window or the mouse button is released. |
---|
| 346 | # |
---|
| 347 | # Arguments: |
---|
| 348 | # w - The entry window. |
---|
| 349 | |
---|
| 350 | proc tkListboxAutoScan {w} { |
---|
| 351 | global tkPriv |
---|
| 352 | if {![winfo exists $w]} return |
---|
| 353 | set x $tkPriv(x) |
---|
| 354 | set y $tkPriv(y) |
---|
| 355 | if {$y >= [winfo height $w]} { |
---|
| 356 | $w yview scroll 1 units |
---|
| 357 | } elseif {$y < 0} { |
---|
| 358 | $w yview scroll -1 units |
---|
| 359 | } elseif {$x >= [winfo width $w]} { |
---|
| 360 | $w xview scroll 2 units |
---|
| 361 | } elseif {$x < 0} { |
---|
| 362 | $w xview scroll -2 units |
---|
| 363 | } else { |
---|
| 364 | return |
---|
| 365 | } |
---|
| 366 | tkListboxMotion $w [$w index @$x,$y] |
---|
| 367 | set tkPriv(afterId) [after 50 [list tkListboxAutoScan $w]] |
---|
| 368 | } |
---|
| 369 | |
---|
| 370 | # tkListboxUpDown -- |
---|
| 371 | # |
---|
| 372 | # Moves the location cursor (active element) up or down by one element, |
---|
| 373 | # and changes the selection if we're in browse or extended selection |
---|
| 374 | # mode. |
---|
| 375 | # |
---|
| 376 | # Arguments: |
---|
| 377 | # w - The listbox widget. |
---|
| 378 | # amount - +1 to move down one item, -1 to move back one item. |
---|
| 379 | |
---|
| 380 | proc tkListboxUpDown {w amount} { |
---|
| 381 | global tkPriv |
---|
| 382 | $w activate [expr {[$w index active] + $amount}] |
---|
| 383 | $w see active |
---|
| 384 | switch [$w cget -selectmode] { |
---|
| 385 | browse { |
---|
| 386 | $w selection clear 0 end |
---|
| 387 | $w selection set active |
---|
| 388 | event generate $w <<ListboxSelect>> |
---|
| 389 | } |
---|
| 390 | extended { |
---|
| 391 | $w selection clear 0 end |
---|
| 392 | $w selection set active |
---|
| 393 | $w selection anchor active |
---|
| 394 | set tkPriv(listboxPrev) [$w index active] |
---|
| 395 | set tkPriv(listboxSelection) {} |
---|
| 396 | event generate $w <<ListboxSelect>> |
---|
| 397 | } |
---|
| 398 | } |
---|
| 399 | } |
---|
| 400 | |
---|
| 401 | # tkListboxExtendUpDown -- |
---|
| 402 | # |
---|
| 403 | # Does nothing unless we're in extended selection mode; in this |
---|
| 404 | # case it moves the location cursor (active element) up or down by |
---|
| 405 | # one element, and extends the selection to that point. |
---|
| 406 | # |
---|
| 407 | # Arguments: |
---|
| 408 | # w - The listbox widget. |
---|
| 409 | # amount - +1 to move down one item, -1 to move back one item. |
---|
| 410 | |
---|
| 411 | proc tkListboxExtendUpDown {w amount} { |
---|
| 412 | if {[string compare [$w cget -selectmode] "extended"]} { |
---|
| 413 | return |
---|
| 414 | } |
---|
| 415 | set active [$w index active] |
---|
| 416 | if {![info exists tkPriv(listboxSelection)]} { |
---|
| 417 | global tkPriv |
---|
| 418 | $w selection set $active |
---|
| 419 | set tkPriv(listboxSelection) [$w curselection] |
---|
| 420 | } |
---|
| 421 | $w activate [expr {$active + $amount}] |
---|
| 422 | $w see active |
---|
| 423 | tkListboxMotion $w [$w index active] |
---|
| 424 | } |
---|
| 425 | |
---|
| 426 | # tkListboxDataExtend |
---|
| 427 | # |
---|
| 428 | # This procedure is called for key-presses such as Shift-KEndData. |
---|
| 429 | # If the selection mode isn't multiple or extend then it does nothing. |
---|
| 430 | # Otherwise it moves the active element to el and, if we're in |
---|
| 431 | # extended mode, extends the selection to that point. |
---|
| 432 | # |
---|
| 433 | # Arguments: |
---|
| 434 | # w - The listbox widget. |
---|
| 435 | # el - An integer element number. |
---|
| 436 | |
---|
| 437 | proc tkListboxDataExtend {w el} { |
---|
| 438 | set mode [$w cget -selectmode] |
---|
| 439 | if {[string equal $mode "extended"]} { |
---|
| 440 | $w activate $el |
---|
| 441 | $w see $el |
---|
| 442 | if {[$w selection includes anchor]} { |
---|
| 443 | tkListboxMotion $w $el |
---|
| 444 | } |
---|
| 445 | } elseif {[string equal $mode "multiple"]} { |
---|
| 446 | $w activate $el |
---|
| 447 | $w see $el |
---|
| 448 | } |
---|
| 449 | } |
---|
| 450 | |
---|
| 451 | # tkListboxCancel |
---|
| 452 | # |
---|
| 453 | # This procedure is invoked to cancel an extended selection in |
---|
| 454 | # progress. If there is an extended selection in progress, it |
---|
| 455 | # restores all of the items between the active one and the anchor |
---|
| 456 | # to their previous selection state. |
---|
| 457 | # |
---|
| 458 | # Arguments: |
---|
| 459 | # w - The listbox widget. |
---|
| 460 | |
---|
| 461 | proc tkListboxCancel w { |
---|
| 462 | global tkPriv |
---|
| 463 | if {[string compare [$w cget -selectmode] "extended"]} { |
---|
| 464 | return |
---|
| 465 | } |
---|
| 466 | set first [$w index anchor] |
---|
| 467 | set last $tkPriv(listboxPrev) |
---|
| 468 | if { [string equal $last ""] } { |
---|
| 469 | # Not actually doing any selection right now |
---|
| 470 | return |
---|
| 471 | } |
---|
| 472 | if {$first > $last} { |
---|
| 473 | set tmp $first |
---|
| 474 | set first $last |
---|
| 475 | set last $tmp |
---|
| 476 | } |
---|
| 477 | $w selection clear $first $last |
---|
| 478 | while {$first <= $last} { |
---|
| 479 | if {[lsearch $tkPriv(listboxSelection) $first] >= 0} { |
---|
| 480 | $w selection set $first |
---|
| 481 | } |
---|
| 482 | incr first |
---|
| 483 | } |
---|
| 484 | event generate $w <<ListboxSelect>> |
---|
| 485 | } |
---|
| 486 | |
---|
| 487 | # tkListboxSelectAll |
---|
| 488 | # |
---|
| 489 | # This procedure is invoked to handle the "select all" operation. |
---|
| 490 | # For single and browse mode, it just selects the active element. |
---|
| 491 | # Otherwise it selects everything in the widget. |
---|
| 492 | # |
---|
| 493 | # Arguments: |
---|
| 494 | # w - The listbox widget. |
---|
| 495 | |
---|
| 496 | proc tkListboxSelectAll w { |
---|
| 497 | set mode [$w cget -selectmode] |
---|
| 498 | if {[string equal $mode "single"] || [string equal $mode "browse"]} { |
---|
| 499 | $w selection clear 0 end |
---|
| 500 | $w selection set active |
---|
| 501 | } else { |
---|
| 502 | $w selection set 0 end |
---|
| 503 | } |
---|
| 504 | event generate $w <<ListboxSelect>> |
---|
| 505 | } |
---|