diff options
Diffstat (limited to 'library/listbox.tcl')
| -rw-r--r-- | library/listbox.tcl | 452 |
1 files changed, 452 insertions, 0 deletions
diff --git a/library/listbox.tcl b/library/listbox.tcl new file mode 100644 index 0000000..4e84b3a --- /dev/null +++ b/library/listbox.tcl @@ -0,0 +1,452 @@ +# listbox.tcl -- +# +# This file defines the default bindings for Tk listbox widgets +# and provides procedures that help in implementing those bindings. +# +# SCCS: @(#) listbox.tcl 1.21 97/06/10 17:13:55 +# +# Copyright (c) 1994 The Regents of the University of California. +# Copyright (c) 1994-1995 Sun Microsystems, Inc. +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. + +#-------------------------------------------------------------------------- +# tkPriv elements used in this file: +# +# afterId - Token returned by "after" for autoscanning. +# listboxPrev - The last element to be selected or deselected +# during a selection operation. +# listboxSelection - All of the items that were selected before the +# current selection operation (such as a mouse +# drag) started; used to cancel an operation. +#-------------------------------------------------------------------------- + +#------------------------------------------------------------------------- +# The code below creates the default class bindings for listboxes. +#------------------------------------------------------------------------- + +# Note: the check for existence of %W below is because this binding +# is sometimes invoked after a window has been deleted (e.g. because +# there is a double-click binding on the widget that deletes it). Users +# can put "break"s in their bindings to avoid the error, but this check +# makes that unnecessary. + +bind Listbox <1> { + if [winfo exists %W] { + tkListboxBeginSelect %W [%W index @%x,%y] + } +} + +# Ignore double clicks so that users can define their own behaviors. +# Among other things, this prevents errors if the user deletes the +# listbox on a double click. + +bind Listbox <Double-1> { + # Empty script +} + +bind Listbox <B1-Motion> { + set tkPriv(x) %x + set tkPriv(y) %y + tkListboxMotion %W [%W index @%x,%y] +} +bind Listbox <ButtonRelease-1> { + tkCancelRepeat + %W activate @%x,%y +} +bind Listbox <Shift-1> { + tkListboxBeginExtend %W [%W index @%x,%y] +} +bind Listbox <Control-1> { + tkListboxBeginToggle %W [%W index @%x,%y] +} +bind Listbox <B1-Leave> { + set tkPriv(x) %x + set tkPriv(y) %y + tkListboxAutoScan %W +} +bind Listbox <B1-Enter> { + tkCancelRepeat +} + +bind Listbox <Up> { + tkListboxUpDown %W -1 +} +bind Listbox <Shift-Up> { + tkListboxExtendUpDown %W -1 +} +bind Listbox <Down> { + tkListboxUpDown %W 1 +} +bind Listbox <Shift-Down> { + tkListboxExtendUpDown %W 1 +} +bind Listbox <Left> { + %W xview scroll -1 units +} +bind Listbox <Control-Left> { + %W xview scroll -1 pages +} +bind Listbox <Right> { + %W xview scroll 1 units +} +bind Listbox <Control-Right> { + %W xview scroll 1 pages +} +bind Listbox <Prior> { + %W yview scroll -1 pages + %W activate @0,0 +} +bind Listbox <Next> { + %W yview scroll 1 pages + %W activate @0,0 +} +bind Listbox <Control-Prior> { + %W xview scroll -1 pages +} +bind Listbox <Control-Next> { + %W xview scroll 1 pages +} +bind Listbox <Home> { + %W xview moveto 0 +} +bind Listbox <End> { + %W xview moveto 1 +} +bind Listbox <Control-Home> { + %W activate 0 + %W see 0 + %W selection clear 0 end + %W selection set 0 +} +bind Listbox <Shift-Control-Home> { + tkListboxDataExtend %W 0 +} +bind Listbox <Control-End> { + %W activate end + %W see end + %W selection clear 0 end + %W selection set end +} +bind Listbox <Shift-Control-End> { + tkListboxDataExtend %W [%W index end] +} +bind Listbox <<Copy>> { + if {[selection own -displayof %W] == "%W"} { + clipboard clear -displayof %W + clipboard append -displayof %W [selection get -displayof %W] + } +} +bind Listbox <space> { + tkListboxBeginSelect %W [%W index active] +} +bind Listbox <Select> { + tkListboxBeginSelect %W [%W index active] +} +bind Listbox <Control-Shift-space> { + tkListboxBeginExtend %W [%W index active] +} +bind Listbox <Shift-Select> { + tkListboxBeginExtend %W [%W index active] +} +bind Listbox <Escape> { + tkListboxCancel %W +} +bind Listbox <Control-slash> { + tkListboxSelectAll %W +} +bind Listbox <Control-backslash> { + if {[%W cget -selectmode] != "browse"} { + %W selection clear 0 end + } +} + +# Additional Tk bindings that aren't part of the Motif look and feel: + +bind Listbox <2> { + %W scan mark %x %y +} +bind Listbox <B2-Motion> { + %W scan dragto %x %y +} + +# tkListboxBeginSelect -- +# +# This procedure is typically invoked on button-1 presses. It begins +# the process of making a selection in the listbox. Its exact behavior +# depends on the selection mode currently in effect for the listbox; +# see the Motif documentation for details. +# +# Arguments: +# w - The listbox widget. +# el - The element for the selection operation (typically the +# one under the pointer). Must be in numerical form. + +proc tkListboxBeginSelect {w el} { + global tkPriv + if {[$w cget -selectmode] == "multiple"} { + if [$w selection includes $el] { + $w selection clear $el + } else { + $w selection set $el + } + } else { + $w selection clear 0 end + $w selection set $el + $w selection anchor $el + set tkPriv(listboxSelection) {} + set tkPriv(listboxPrev) $el + } +} + +# tkListboxMotion -- +# +# This procedure is called to process mouse motion events while +# button 1 is down. It may move or extend the selection, depending +# on the listbox's selection mode. +# +# Arguments: +# w - The listbox widget. +# el - The element under the pointer (must be a number). + +proc tkListboxMotion {w el} { + global tkPriv + if {$el == $tkPriv(listboxPrev)} { + return + } + set anchor [$w index anchor] + switch [$w cget -selectmode] { + browse { + $w selection clear 0 end + $w selection set $el + set tkPriv(listboxPrev) $el + } + extended { + set i $tkPriv(listboxPrev) + if [$w selection includes anchor] { + $w selection clear $i $el + $w selection set anchor $el + } else { + $w selection clear $i $el + $w selection clear anchor $el + } + while {($i < $el) && ($i < $anchor)} { + if {[lsearch $tkPriv(listboxSelection) $i] >= 0} { + $w selection set $i + } + incr i + } + while {($i > $el) && ($i > $anchor)} { + if {[lsearch $tkPriv(listboxSelection) $i] >= 0} { + $w selection set $i + } + incr i -1 + } + set tkPriv(listboxPrev) $el + } + } +} + +# tkListboxBeginExtend -- +# +# This procedure is typically invoked on shift-button-1 presses. It +# begins the process of extending a selection in the listbox. Its +# exact behavior depends on the selection mode currently in effect +# for the listbox; see the Motif documentation for details. +# +# Arguments: +# w - The listbox widget. +# el - The element for the selection operation (typically the +# one under the pointer). Must be in numerical form. + +proc tkListboxBeginExtend {w el} { + if {[$w cget -selectmode] == "extended"} { + if {[$w selection includes anchor]} { + tkListboxMotion $w $el + } else { + # No selection yet; simulate the begin-select operation. + + tkListboxBeginSelect $w $el + } + } +} + +# tkListboxBeginToggle -- +# +# This procedure is typically invoked on control-button-1 presses. It +# begins the process of toggling a selection in the listbox. Its +# exact behavior depends on the selection mode currently in effect +# for the listbox; see the Motif documentation for details. +# +# Arguments: +# w - The listbox widget. +# el - The element for the selection operation (typically the +# one under the pointer). Must be in numerical form. + +proc tkListboxBeginToggle {w el} { + global tkPriv + if {[$w cget -selectmode] == "extended"} { + set tkPriv(listboxSelection) [$w curselection] + set tkPriv(listboxPrev) $el + $w selection anchor $el + if [$w selection includes $el] { + $w selection clear $el + } else { + $w selection set $el + } + } +} + +# tkListboxAutoScan -- +# This procedure is invoked when the mouse leaves an entry window +# with button 1 down. It scrolls the window up, down, left, or +# right, depending on where the mouse left the window, and reschedules +# itself as an "after" command so that the window continues to scroll until +# the mouse moves back into the window or the mouse button is released. +# +# Arguments: +# w - The entry window. + +proc tkListboxAutoScan {w} { + global tkPriv + if {![winfo exists $w]} return + set x $tkPriv(x) + set y $tkPriv(y) + if {$y >= [winfo height $w]} { + $w yview scroll 1 units + } elseif {$y < 0} { + $w yview scroll -1 units + } elseif {$x >= [winfo width $w]} { + $w xview scroll 2 units + } elseif {$x < 0} { + $w xview scroll -2 units + } else { + return + } + tkListboxMotion $w [$w index @$x,$y] + set tkPriv(afterId) [after 50 tkListboxAutoScan $w] +} + +# tkListboxUpDown -- +# +# Moves the location cursor (active element) up or down by one element, +# and changes the selection if we're in browse or extended selection +# mode. +# +# Arguments: +# w - The listbox widget. +# amount - +1 to move down one item, -1 to move back one item. + +proc tkListboxUpDown {w amount} { + global tkPriv + $w activate [expr [$w index active] + $amount] + $w see active + switch [$w cget -selectmode] { + browse { + $w selection clear 0 end + $w selection set active + } + extended { + $w selection clear 0 end + $w selection set active + $w selection anchor active + set tkPriv(listboxPrev) [$w index active] + set tkPriv(listboxSelection) {} + } + } +} + +# tkListboxExtendUpDown -- +# +# Does nothing unless we're in extended selection mode; in this +# case it moves the location cursor (active element) up or down by +# one element, and extends the selection to that point. +# +# Arguments: +# w - The listbox widget. +# amount - +1 to move down one item, -1 to move back one item. + +proc tkListboxExtendUpDown {w amount} { + if {[$w cget -selectmode] != "extended"} { + return + } + $w activate [expr [$w index active] + $amount] + $w see active + tkListboxMotion $w [$w index active] +} + +# tkListboxDataExtend +# +# This procedure is called for key-presses such as Shift-KEndData. +# If the selection mode isn't multiple or extend then it does nothing. +# Otherwise it moves the active element to el and, if we're in +# extended mode, extends the selection to that point. +# +# Arguments: +# w - The listbox widget. +# el - An integer element number. + +proc tkListboxDataExtend {w el} { + set mode [$w cget -selectmode] + if {$mode == "extended"} { + $w activate $el + $w see $el + if [$w selection includes anchor] { + tkListboxMotion $w $el + } + } elseif {$mode == "multiple"} { + $w activate $el + $w see $el + } +} + +# tkListboxCancel +# +# This procedure is invoked to cancel an extended selection in +# progress. If there is an extended selection in progress, it +# restores all of the items between the active one and the anchor +# to their previous selection state. +# +# Arguments: +# w - The listbox widget. + +proc tkListboxCancel w { + global tkPriv + if {[$w cget -selectmode] != "extended"} { + return + } + set first [$w index anchor] + set last $tkPriv(listboxPrev) + if {$first > $last} { + set tmp $first + set first $last + set last $tmp + } + $w selection clear $first $last + while {$first <= $last} { + if {[lsearch $tkPriv(listboxSelection) $first] >= 0} { + $w selection set $first + } + incr first + } +} + +# tkListboxSelectAll +# +# This procedure is invoked to handle the "select all" operation. +# For single and browse mode, it just selects the active element. +# Otherwise it selects everything in the widget. +# +# Arguments: +# w - The listbox widget. + +proc tkListboxSelectAll w { + set mode [$w cget -selectmode] + if {($mode == "single") || ($mode == "browse")} { + $w selection clear 0 end + $w selection set active + } else { + $w selection set 0 end + } +} |