blob: 8f8d0ce6854ee8a03bea6e509601a711e8ef6d9d [file] [log] [blame]
#
# 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: scrolledlistbox.itk,v 1.9 2002/03/16 16:25:44 mgbacke Exp $
# ----------------------------------------------------------------------
# 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)
}