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