summaryrefslogtreecommitdiffstats
path: root/library/listbox.tcl
diff options
context:
space:
mode:
Diffstat (limited to 'library/listbox.tcl')
-rw-r--r--library/listbox.tcl452
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
+ }
+}