diff options
Diffstat (limited to 'iwidgets/generic/scrolledlistbox.itk')
| -rw-r--r-- | iwidgets/generic/scrolledlistbox.itk | 732 |
1 files changed, 732 insertions, 0 deletions
diff --git a/iwidgets/generic/scrolledlistbox.itk b/iwidgets/generic/scrolledlistbox.itk new file mode 100644 index 00000000000..18d6a61a08f --- /dev/null +++ b/iwidgets/generic/scrolledlistbox.itk @@ -0,0 +1,732 @@ +# +# Scrolledlistbox +# ---------------------------------------------------------------------- +# Implements a scrolled listbox with additional options to manage +# horizontal and vertical scrollbars. This includes options to control +# which scrollbars are displayed and the method, i.e. statically, +# dynamically, or none at all. +# +# ---------------------------------------------------------------------- +# AUTHOR: Mark L. Ulferts EMAIL: mulferts@austin.dsccc.com +# +# @(#) $Id$ +# ---------------------------------------------------------------------- +# Copyright (c) 1995 DSC Technologies Corporation +# ====================================================================== +# Permission to use, copy, modify, distribute and license this software +# and its documentation for any purpose, and without fee or written +# agreement with DSC, is hereby granted, provided that the above copyright +# notice appears in all copies and that both the copyright notice and +# warranty disclaimer below appear in supporting documentation, and that +# the names of DSC Technologies Corporation or DSC Communications +# Corporation not be used in advertising or publicity pertaining to the +# software without specific, written prior permission. +# +# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING +# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- +# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE +# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, +# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL +# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR +# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, +# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, +# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS +# SOFTWARE. +# ====================================================================== + +# +# Usual options. +# +itk::usual Scrolledlistbox { + keep -activebackground -activerelief -background -borderwidth -cursor \ + -elementborderwidth -foreground -highlightcolor -highlightthickness \ + -jump -labelfont -selectbackground -selectborderwidth \ + -selectforeground -textbackground -textfont -troughcolor +} + +# ------------------------------------------------------------------ +# SCROLLEDLISTBOX +# ------------------------------------------------------------------ +itcl::class iwidgets::Scrolledlistbox { + inherit iwidgets::Scrolledwidget + + constructor {args} {} + destructor {} + + itk_option define -dblclickcommand dblClickCommand Command {} + itk_option define -selectioncommand selectionCommand Command {} + itk_option define -width width Width 0 + itk_option define -height height Height 0 + itk_option define -visibleitems visibleItems VisibleItems 20x10 + itk_option define -state state State normal + + public method curselection {} + public method activate {index} + public method bbox {index} + public method clear {} + public method see {index} + public method index {index} + public method delete {first {last {}}} + public method get {first {last {}}} + public method getcurselection {} + public method insert {index args} + public method nearest {y} + public method scan {option args} + public method selection {option first {last {}}} + public method size {} + public method selecteditemcount {} + public method justify {direction} + public method sort {{mode ascending}} + public method xview {args} + public method yview {args} + public method itemconfigure {args} + + protected method _makeSelection {} + protected method _dblclick {} + protected method _fixIndex {index} + + # + # List the event sequences that invoke single and double selection. + # Should these change in the underlying Tk listbox, then they must + # change here too. + # + common doubleSelectSeq { \ + <Double-1> + } + + common singleSelectSeq { \ + <Control-Key-backslash> \ + <Control-Key-slash> \ + <Key-Escape> \ + <Shift-Key-Select> \ + <Control-Shift-Key-space> \ + <Key-Select> \ + <Key-space> \ + <Control-Shift-Key-End> \ + <Control-Key-End> \ + <Control-Shift-Key-Home> \ + <Control-Key-Home> \ + <Key-Down> \ + <Key-Up> \ + <Shift-Key-Down> \ + <Shift-Key-Up> \ + <Control-Button-1> \ + <Shift-Button-1> \ + <ButtonRelease-1> \ + } +} + +# +# Provide a lowercased access method for the Scrolledlistbox class. +# +proc ::iwidgets::scrolledlistbox {pathName args} { + uplevel ::iwidgets::Scrolledlistbox $pathName $args +} + +# +# Use option database to override default resources of base classes. +# +option add *Scrolledlistbox.labelPos n widgetDefault + +# ------------------------------------------------------------------ +# CONSTRUCTOR +# ------------------------------------------------------------------ +itcl::body iwidgets::Scrolledlistbox::constructor {args} { + # + # Our -width and -height options are slightly different than + # those implemented by our base class, so we're going to + # remove them and redefine our own. + # + itk_option remove iwidgets::Scrolledwidget::width + itk_option remove iwidgets::Scrolledwidget::height + + # + # Create the listbox. + # + itk_component add listbox { + listbox $itk_interior.listbox \ + -width 1 -height 1 \ + -xscrollcommand \ + [itcl::code $this _scrollWidget $itk_interior.horizsb] \ + -yscrollcommand \ + [itcl::code $this _scrollWidget $itk_interior.vertsb] + } { + usual + + keep -borderwidth -exportselection -relief -selectmode + keep -listvariable + + rename -font -textfont textFont Font + rename -background -textbackground textBackground Background + rename -highlightbackground -background background Background + } + grid $itk_component(listbox) -row 0 -column 0 -sticky nsew + grid rowconfigure $_interior 0 -weight 1 + grid columnconfigure $_interior 0 -weight 1 + + # + # Configure the command on the vertical scroll bar in the base class. + # + $itk_component(vertsb) configure \ + -command [itcl::code $itk_component(listbox) yview] + + # + # Configure the command on the horizontal scroll bar in the base class. + # + $itk_component(horizsb) configure \ + -command [itcl::code $itk_component(listbox) xview] + + # + # Create a set of bindings for monitoring the selection and install + # them on the listbox component. + # + foreach seq $singleSelectSeq { + bind SLBSelect$this $seq [itcl::code $this _makeSelection] + } + + foreach seq $doubleSelectSeq { + bind SLBSelect$this $seq [itcl::code $this _dblclick] + } + + bindtags $itk_component(listbox) \ + [linsert [bindtags $itk_component(listbox)] end SLBSelect$this] + + # + # Also create a set of bindings for disabling the scrolledlistbox. + # Since the command for it is "break", we can drop the $this since + # they don't need to be unique to the object level. + # + if {[bind SLBDisabled] == {}} { + foreach seq $singleSelectSeq { + bind SLBDisabled $seq break + } + + bind SLBDisabled <Button-1> break + + foreach seq $doubleSelectSeq { + bind SLBDisabled $seq break + } + } + + # + # Initialize the widget based on the command line options. + # + eval itk_initialize $args +} + +# ------------------------------------------------------------------ +# DESTURCTOR +# ------------------------------------------------------------------ +itcl::body iwidgets::Scrolledlistbox::destructor {} { +} + +# ------------------------------------------------------------------ +# OPTIONS +# ------------------------------------------------------------------ + +# ------------------------------------------------------------------ +# OPTION: -dblclickcommand +# +# Specify a command to be executed upon double click of a listbox +# item. Also, create a couple of bindings used for specific +# selection modes +# ------------------------------------------------------------------ +itcl::configbody iwidgets::Scrolledlistbox::dblclickcommand {} + +# ------------------------------------------------------------------ +# OPTION: -selectioncommand +# +# Specifies a command to be executed upon selection of a listbox +# item. The command will be called upon each selection regardless +# of selection mode.. +# ------------------------------------------------------------------ +itcl::configbody iwidgets::Scrolledlistbox::selectioncommand {} + +# ------------------------------------------------------------------ +# OPTION: -width +# +# Specifies the width of the scrolled list box as an entire unit. +# The value may be specified in any of the forms acceptable to +# Tk_GetPixels. Any additional space needed to display the other +# components such as margins and scrollbars force the listbox +# to be compressed. A value of zero along with the same value for +# the height causes the value given for the visibleitems option +# to be applied which administers geometry constraints in a different +# manner. +# ------------------------------------------------------------------ +itcl::configbody iwidgets::Scrolledlistbox::width { + if {$itk_option(-width) != 0} { + set shell [lindex [grid info $itk_component(listbox)] 1] + + # + # Due to a bug in the tk4.2 grid, we have to check the + # propagation before setting it. Setting it to the same + # value it already is will cause it to toggle. + # + if {[grid propagate $shell]} { + grid propagate $shell no + } + + $itk_component(listbox) configure -width 1 + $shell configure \ + -width [winfo pixels $shell $itk_option(-width)] + } else { + configure -visibleitems $itk_option(-visibleitems) + } +} + +# ------------------------------------------------------------------ +# OPTION: -height +# +# Specifies the height of the scrolled list box as an entire unit. +# The value may be specified in any of the forms acceptable to +# Tk_GetPixels. Any additional space needed to display the other +# components such as margins and scrollbars force the listbox +# to be compressed. A value of zero along with the same value for +# the width causes the value given for the visibleitems option +# to be applied which administers geometry constraints in a different +# manner. +# ------------------------------------------------------------------ +itcl::configbody iwidgets::Scrolledlistbox::height { + if {$itk_option(-height) != 0} { + set shell [lindex [grid info $itk_component(listbox)] 1] + + # + # Due to a bug in the tk4.2 grid, we have to check the + # propagation before setting it. Setting it to the same + # value it already is will cause it to toggle. + # + if {[grid propagate $shell]} { + grid propagate $shell no + } + + $itk_component(listbox) configure -height 1 + $shell configure \ + -height [winfo pixels $shell $itk_option(-height)] + } else { + configure -visibleitems $itk_option(-visibleitems) + } +} + +# ------------------------------------------------------------------ +# OPTION: -visibleitems +# +# Specified the widthxheight in characters and lines for the listbox. +# This option is only administered if the width and height options +# are both set to zero, otherwise they take precedence. With the +# visibleitems option engaged, geometry constraints are maintained +# only on the listbox. The size of the other components such as +# labels, margins, and scrollbars, are additive and independent, +# effecting the overall size of the scrolled list box. In contrast, +# should the width and height options have non zero values, they +# are applied to the scrolled list box as a whole. The listbox +# is compressed or expanded to maintain the geometry constraints. +# ------------------------------------------------------------------ +itcl::configbody iwidgets::Scrolledlistbox::visibleitems { + if {[regexp {^[0-9]+x[0-9]+$} $itk_option(-visibleitems)]} { + if {($itk_option(-width) == 0) && \ + ($itk_option(-height) == 0)} { + set chars [lindex [split $itk_option(-visibleitems) x] 0] + set lines [lindex [split $itk_option(-visibleitems) x] 1] + + set shell [lindex [grid info $itk_component(listbox)] 1] + + # + # Due to a bug in the tk4.2 grid, we have to check the + # propagation before setting it. Setting it to the same + # value it already is will cause it to toggle. + # + if {! [grid propagate $shell]} { + grid propagate $shell yes + } + + $itk_component(listbox) configure -width $chars -height $lines + } + + } else { + error "bad visibleitems option\ + \"$itk_option(-visibleitems)\": should be\ + widthxheight" + } +} + +# ------------------------------------------------------------------ +# OPTION: -state +# +# Specifies the state of the scrolledlistbox which may be either +# disabled or normal. In a disabled state, the scrolledlistbox +# does not accept user selection. The default is normal. +# ------------------------------------------------------------------ +itcl::configbody iwidgets::Scrolledlistbox::state { + set tags [bindtags $itk_component(listbox)] + + # + # If the state is normal, then we need to remove the disabled + # bindings if they exist. If the state is disabled, then we need + # to install the disabled bindings if they haven't been already. + # + switch -- $itk_option(-state) { + normal { + $itk_component(listbox) configure \ + -foreground $itk_option(-foreground) + $itk_component(listbox) configure \ + -selectforeground $itk_option(-selectforeground) + if {[set index [lsearch $tags SLBDisabled]] != -1} { + bindtags $itk_component(listbox) \ + [lreplace $tags $index $index] + } + } + + disabled { + $itk_component(listbox) configure \ + -foreground $itk_option(-disabledforeground) + $itk_component(listbox) configure \ + -selectforeground $itk_option(-disabledforeground) + if {[set index [lsearch $tags SLBDisabled]] == -1} { + bindtags $itk_component(listbox) \ + [linsert $tags 1 SLBDisabled] + } + } + default { + error "bad state value \"$itk_option(-state)\":\ + must be normal or disabled" + } + } +} + +# ------------------------------------------------------------------ +# METHODS +# ------------------------------------------------------------------ + +# ------------------------------------------------------------------ +# METHOD: curselection +# +# Returns a list containing the indices of all the elements in the +# listbox that are currently selected. +# ------------------------------------------------------------------ +itcl::body iwidgets::Scrolledlistbox::curselection {} { + return [$itk_component(listbox) curselection] +} + +# ------------------------------------------------------------------ +# METHOD: activate index +# +# Sets the active element to the one indicated by index. +# ------------------------------------------------------------------ +itcl::body iwidgets::Scrolledlistbox::activate {index} { + return [$itk_component(listbox) activate [_fixIndex $index]] +} + +# ------------------------------------------------------------------ +# METHOD: bbox index +# +# Returns four element list describing the bounding box for the list +# item at index +# ------------------------------------------------------------------ +itcl::body iwidgets::Scrolledlistbox::bbox {index} { + return [$itk_component(listbox) bbox [_fixIndex $index]] +} + +# ------------------------------------------------------------------ +# METHOD clear +# +# Clear the listbox area of all items. +# ------------------------------------------------------------------ +itcl::body iwidgets::Scrolledlistbox::clear {} { + delete 0 end +} + +# ------------------------------------------------------------------ +# METHOD: see index +# +# Adjusts the view such that the element given by index is visible. +# ------------------------------------------------------------------ +itcl::body iwidgets::Scrolledlistbox::see {index} { + $itk_component(listbox) see [_fixIndex $index] +} + +# ------------------------------------------------------------------ +# METHOD: index index +# +# Returns the decimal string giving the integer index corresponding +# to index. The index value may be a integer number, active, +# anchor, end, @x,y, or a pattern. +# ------------------------------------------------------------------ +itcl::body iwidgets::Scrolledlistbox::index {index} { + if {[regexp {(^[0-9]+$)|(^active$)|(^anchor$)|(^end$)|(^@-?[0-9]+,-?[0-9]+$)} $index]} { + return [$itk_component(listbox) index $index] + + } else { + set indexValue [lsearch -glob [get 0 end] $index] + if {$indexValue == -1} { + error "bad Scrolledlistbox index \"$index\": must be active,\ + anchor, end, @x,y, number, or a pattern" + } + return $indexValue + } +} + +# ------------------------------------------------------------------ +# METHOD: _fixIndex index +# +# Similar to the regular "index" method, but it only converts +# the index to a numerical value if it is a string pattern. If +# the index is in the proper form to be used with the listbox, +# it is left alone. This fixes problems associated with converting +# an index such as "end" to a numerical value. +# ------------------------------------------------------------------ +itcl::body iwidgets::Scrolledlistbox::_fixIndex {index} { + if {[regexp {(^[0-9]+$)|(^active$)|(^anchor$)|(^end$)|(^@[0-9]+,[0-9]+$)} \ + $index]} { + return $index + + } else { + set indexValue [lsearch -glob [get 0 end] $index] + + if {$indexValue == -1} { + error "bad Scrolledlistbox index \"$index\": must be active,\ + anchor, end, @x,y, number, or a pattern" + } + return $indexValue + } +} + +# ------------------------------------------------------------------ +# METHOD: delete first ?last? +# +# Delete one or more elements from list box based on the first and +# last index values. Indexes may be a number, active, anchor, end, +# @x,y, or a pattern. +# ------------------------------------------------------------------ +itcl::body iwidgets::Scrolledlistbox::delete {first {last {}}} { + set first [_fixIndex $first] + + if {$last != {}} { + set last [_fixIndex $last] + } else { + set last $first + } + + eval $itk_component(listbox) delete $first $last +} + +# ------------------------------------------------------------------ +# METHOD: get first ?last? +# +# Returns the elements of the listbox indicated by the indexes. +# Indexes may be a number, active, anchor, end, @x,y, ora pattern. +# ------------------------------------------------------------------ +itcl::body iwidgets::Scrolledlistbox::get {first {last {}}} { + set first [_fixIndex $first] + + if {$last != {}} { + set last [_fixIndex $last] + } + + if {$last == {}} { + return [$itk_component(listbox) get $first] + } else { + return [$itk_component(listbox) get $first $last] + } +} + +# ------------------------------------------------------------------ +# METHOD: getcurselection +# +# Returns the contents of the listbox element indicated by the current +# selection indexes. Short cut version of get and curselection +# command combination. +# ------------------------------------------------------------------ +itcl::body iwidgets::Scrolledlistbox::getcurselection {} { + set rlist {} + + if {[selecteditemcount] > 0} { + set cursels [$itk_component(listbox) curselection] + + switch $itk_option(-selectmode) { + single - + browse { + set rlist [$itk_component(listbox) get $cursels] + } + + multiple - + extended { + foreach sel $cursels { + lappend rlist [$itk_component(listbox) get $sel] + } + } + } + } + + return $rlist +} + +# ------------------------------------------------------------------ +# METHOD: insert index string ?string ...? +# +# Insert zero or more elements in the list just before the element +# given by index. +# ------------------------------------------------------------------ +itcl::body iwidgets::Scrolledlistbox::insert {index args} { + set index [_fixIndex $index] + + eval $itk_component(listbox) insert $index $args +} + +# ------------------------------------------------------------------ +# METHOD: nearest y +# +# Given a y-coordinate within the listbox, this command returns the +# index of the visible listbox element nearest to that y-coordinate. +# ------------------------------------------------------------------ +itcl::body iwidgets::Scrolledlistbox::nearest {y} { + $itk_component(listbox) nearest $y +} + +# ------------------------------------------------------------------ +# METHOD: scan option args +# +# Implements scanning on listboxes. +# ------------------------------------------------------------------ +itcl::body iwidgets::Scrolledlistbox::scan {option args} { + eval $itk_component(listbox) scan $option $args +} + +# ------------------------------------------------------------------ +# METHOD: selection option first ?last? +# +# Adjusts the selection within the listbox. The index value may be +# a integer number, active, anchor, end, @x,y, or a pattern. +# ------------------------------------------------------------------ +itcl::body iwidgets::Scrolledlistbox::selection {option first {last {}}} { + set first [_fixIndex $first] + + if {$last != {}} { + set last [_fixIndex $last] + $itk_component(listbox) selection $option $first $last + } else { + $itk_component(listbox) selection $option $first + } +} + +# ------------------------------------------------------------------ +# METHOD: size +# +# Returns a decimal string indicating the total number of elements +# in the listbox. +# ------------------------------------------------------------------ +itcl::body iwidgets::Scrolledlistbox::size {} { + return [$itk_component(listbox) size] +} + +# ------------------------------------------------------------------ +# METHOD: selecteditemcount +# +# Returns a decimal string indicating the total number of selected +# elements in the listbox. +# ------------------------------------------------------------------ +itcl::body iwidgets::Scrolledlistbox::selecteditemcount {} { + return [llength [$itk_component(listbox) curselection]] +} + +# ------------------------------------------------------------------ +# METHOD: justify direction +# +# Justifies the list scrolled region in one of four directions: top, +# bottom, left, or right. +# ------------------------------------------------------------------ +itcl::body iwidgets::Scrolledlistbox::justify {direction} { + switch $direction { + left { + $itk_component(listbox) xview moveto 0 + } + right { + $itk_component(listbox) xview moveto 1 + } + top { + $itk_component(listbox) yview moveto 0 + } + bottom { + $itk_component(listbox) yview moveto 1 + } + default { + error "bad justify argument \"$direction\": should\ + be left, right, top, or bottom" + } + } +} + +# ------------------------------------------------------------------ +# METHOD: sort mode +# +# Sort the current list. This can take any sort switch from +# the lsort command: ascii, integer, real, command, +# increasing/ascending, decreasing/descending, etc. +# +# ------------------------------------------------------------------ +itcl::body iwidgets::Scrolledlistbox::sort {{mode ascending}} { + + set vals [$itk_component(listbox) get 0 end] + if {[llength $vals] == 0} {return} + + switch $mode { + ascending {set mode increasing} + descending {set mode decreasing} + } + + $itk_component(listbox) delete 0 end + if {[catch {eval $itk_component(listbox) insert end \ + [lsort -${mode} $vals]} errorstring]} { + error "bad sort argument \"$mode\": must be a valid argument to the\ + Tcl lsort command" + } + + return +} + +# ------------------------------------------------------------------ +# METHOD: xview args +# +# Change or query the vertical position of the text in the list box. +# ------------------------------------------------------------------ +itcl::body iwidgets::Scrolledlistbox::xview {args} { + return [eval $itk_component(listbox) xview $args] +} + +# ------------------------------------------------------------------ +# METHOD: yview args +# +# Change or query the horizontal position of the text in the list box. +# ------------------------------------------------------------------ +itcl::body iwidgets::Scrolledlistbox::yview {args} { + return [eval $itk_component(listbox) yview $args] +} + +# ------------------------------------------------------------------ +# METHOD: itemconfigure args +# +# This is a wrapper method around the new tk8.3 itemconfigure command +# for the listbox. +# ------------------------------------------------------------------ +itcl::body iwidgets::Scrolledlistbox::itemconfigure {args} { + return [eval $itk_component(listbox) itemconfigure $args] +} + +# ------------------------------------------------------------------ +# PROTECTED METHOD: _makeSelection +# +# Evaluate the selection command. +# ------------------------------------------------------------------ +itcl::body iwidgets::Scrolledlistbox::_makeSelection {} { + uplevel #0 $itk_option(-selectioncommand) +} + +# ------------------------------------------------------------------ +# PROTECTED METHOD: _dblclick +# +# Evaluate the double click command option if not empty. +# ------------------------------------------------------------------ +itcl::body iwidgets::Scrolledlistbox::_dblclick {} { + uplevel #0 $itk_option(-dblclickcommand) +} + |