I386LINUX/util/I386LINUX/lib/tk8.3/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 # 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 }