Subversion Repositories or1k

#

# 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.1.1.1 2002-01-16 10:24:50 markom 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

# ------------------------------------------------------------------

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 string 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}

    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 { \

    }

    common singleSelectSeq { \

         \

         \

         \

         \

         \

         \

         \

         \

         \

         \

         \

         \

         \

         \

         \

         \

         \

         \

    }

}

#

# 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

# ------------------------------------------------------------------

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 \

                [code $this _scrollWidget $itk_interior.horizsb] \

                -yscrollcommand \

                [code $this _scrollWidget $itk_interior.vertsb]

    } {

        usual

        keep -borderwidth -exportselection -relief -selectmode

        rename -font -textfont textFont Font

        rename -background -textbackground textBackground Background

        rename -highlightbackground -background background Background

    }

    grid $itk_component(listbox) -row 1 -column 1 -sticky nsew

    grid rowconfigure $_interior 1 -weight 1

    grid columnconfigure $_interior 1 -weight 1

    #

    # Configure the command on the vertical scroll bar in the base class.

    #

    $itk_component(vertsb) configure \

        -command [code $itk_component(listbox) yview]

    #

    # Configure the command on the horizontal scroll bar in the base class.

    #

    $itk_component(horizsb) configure \

                -command [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 [code $this _makeSelection]

    }

    foreach seq $doubleSelectSeq {

        bind SLBSelect$this $seq [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  break

        foreach seq $doubleSelectSeq {

            bind SLBDisabled $seq break

        }

    }

    #

    # Initialize the widget based on the command line options.

    #

    eval itk_initialize $args

}

# ------------------------------------------------------------------

#                           DESTURCTOR

# ------------------------------------------------------------------

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

# ------------------------------------------------------------------

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..

# ------------------------------------------------------------------

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.

# ------------------------------------------------------------------

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.

# ------------------------------------------------------------------

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.

# ------------------------------------------------------------------

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.

# ------------------------------------------------------------------

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 {

            if {[set index [lsearch $tags SLBDisabled]] != -1} {

                bindtags $itk_component(listbox) \

                    [lreplace $tags $index $index]

            }

        }

        disabled {

            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.

# ------------------------------------------------------------------

body iwidgets::Scrolledlistbox::curselection {} {

    return [$itk_component(listbox) curselection]

}

# ------------------------------------------------------------------

# METHOD: activate index

#

# Sets the active element to the one indicated by index.

# ------------------------------------------------------------------

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

# ------------------------------------------------------------------

body iwidgets::Scrolledlistbox::bbox {index} {

    return [$itk_component(listbox) bbox [_fixIndex $index]]

}

# ------------------------------------------------------------------

# METHOD clear

#

# Clear the listbox area of all items.

# ------------------------------------------------------------------

body iwidgets::Scrolledlistbox::clear {} {

    delete 0 end

}

# ------------------------------------------------------------------

# METHOD: see index

#

# Adjusts the view such that the element given by index is visible.

# ------------------------------------------------------------------

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.

# ------------------------------------------------------------------

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.

# ------------------------------------------------------------------

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.

# ------------------------------------------------------------------

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.

# ------------------------------------------------------------------

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.

# ------------------------------------------------------------------

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.

# ------------------------------------------------------------------

body iwidgets::Scrolledlistbox::insert {index string args} {

    set index [_fixIndex $index]

    set args [linsert $args 0 $string]

    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.

# ------------------------------------------------------------------

body iwidgets::Scrolledlistbox::nearest {y} {

    $itk_component(listbox) nearest $y

}

# ------------------------------------------------------------------

# METHOD: scan option args

#

# Implements scanning on listboxes.

# ------------------------------------------------------------------

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.

# ------------------------------------------------------------------

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.

# ------------------------------------------------------------------

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.

# ------------------------------------------------------------------

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.

# ------------------------------------------------------------------

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 in either "ascending/increasing" or

# "descending/decreasing" order.

# ------------------------------------------------------------------

body iwidgets::Scrolledlistbox::sort {{mode ascending}} {

    switch $mode {

        ascending -

        increasing {

            set vals [$itk_component(listbox) get 0 end]

            if {[llength $vals] != 0} {

                $itk_component(listbox) delete 0 end

                eval $itk_component(listbox) insert end \

                    [lsort -increasing $vals]

            }

        }

        descending -

        decreasing {

            set vals [$itk_component(listbox) get 0 end]

            if {[llength $vals] != 0} {

                $itk_component(listbox) delete 0 end

                eval $itk_component(listbox) insert end \

                    [lsort -decreasing $vals]

            }

        }

        default {

            error "bad sort argument \"$mode\": should be\

                    ascending, descending, increasing, or decreasing"

        }

    }

}

# ------------------------------------------------------------------

# METHOD: xview args

#

# Change or query the vertical position of the text in the list box.

# ------------------------------------------------------------------

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.

# ------------------------------------------------------------------

body iwidgets::Scrolledlistbox::yview {args} {

    return [eval $itk_component(listbox) yview $args]

}

# ------------------------------------------------------------------

# PROTECTED METHOD: _makeSelection

#

# Evaluate the selection command.

# ------------------------------------------------------------------

body iwidgets::Scrolledlistbox::_makeSelection {} {

    uplevel #0 $itk_option(-selectioncommand)

}

# ------------------------------------------------------------------

# PROTECTED METHOD: _dblclick

#

# Evaluate the double click command option if not empty.

# ------------------------------------------------------------------

body iwidgets::Scrolledlistbox::_dblclick {} {

    uplevel #0 $itk_option(-dblclickcommand)

}