Subversion Repositories or1k_old

#

# Selectionbox

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

# Implements a selection box composed of a scrolled list of items and

# a selection entry field.  The user may choose any of the items displayed

# in the scrolled list of alternatives and the selection field will be

# filled with the choice.  The user is also free to enter a new value in

# the selection entry field.  Both the list and entry areas have labels.

# A child site is also provided in which the user may create other widgets

# to be used in conjunction with the selection box.

#

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

#  AUTHOR: Mark L. Ulferts              EMAIL: mulferts@austin.dsccc.com

#

#  @(#) $Id: selectionbox.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 Selectionbox {

    keep -activebackground -activerelief -background -borderwidth -cursor \

         -elementborderwidth -foreground -highlightcolor -highlightthickness \

         -insertbackground -insertborderwidth -insertofftime -insertontime \

         -insertwidth -jump -labelfont -selectbackground -selectborderwidth \

         -selectforeground -textbackground -textfont -troughcolor

}

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

#                            SELECTIONBOX

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

class iwidgets::Selectionbox {

    inherit itk::Widget

    constructor {args} {}

    destructor {}

    itk_option define -childsitepos childSitePos Position center

    itk_option define -margin margin Margin 7

    itk_option define -itemson itemsOn ItemsOn true

    itk_option define -selectionon selectionOn SelectionOn true

    itk_option define -width width Width 260

    itk_option define -height height Height 320

    public method childsite {}

    public method get {}

    public method curselection {}

    public method clear {component}

    public method insert {component index args}

    public method delete {first {last {}}}

    public method size {}

    public method scan {option args}

    public method nearest {y}

    public method index {index}

    public method selection {option args}

    public method selectitem {}

    private method _packComponents {{when later}}

    private variable _repacking {}     ;# non-null => _packComponents pending

}

#

# Provide a lowercased access method for the Selectionbox class.

#

proc ::iwidgets::selectionbox {pathName args} {

    uplevel ::iwidgets::Selectionbox $pathName $args

}

#

# Use option database to override default resources of base classes.

#

option add *Selectionbox.itemsLabel Items widgetDefault

option add *Selectionbox.selectionLabel Selection widgetDefault

option add *Selectionbox.width 260 widgetDefault

option add *Selectionbox.height 320 widgetDefault

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

#                        CONSTRUCTOR

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

body iwidgets::Selectionbox::constructor {args} {

    #

    # Set the borderwidth to zero and add width and height options

    # back to the hull.

    #

    component hull configure -borderwidth 0

    itk_option add hull.width hull.height

    #

    # Create the child site widget.

    #

    itk_component add -protected sbchildsite {

        frame $itk_interior.sbchildsite

    }

    #

    # Create the items list.

    #

    itk_component add items {

        iwidgets::Scrolledlistbox $itk_interior.items -selectmode single \

                -visibleitems 20x10 -labelpos nw -vscrollmode static \

                -hscrollmode none

    } {

        usual

        keep -dblclickcommand -exportselection

        rename -labeltext -itemslabel itemsLabel Text

        rename -selectioncommand -itemscommand itemsCommand Command

    }

    configure -itemscommand [code $this selectitem]

    #

    # Create the selection entry.

    #

    itk_component add selection {

        iwidgets::Entryfield $itk_interior.selection -labelpos nw

    } {

        usual

        keep -exportselection

        rename -labeltext -selectionlabel selectionLabel Text

        rename -command -selectioncommand selectionCommand Command

    }

    #

    # Set the interior to the childsite for derived classes.

    #

    set itk_interior $itk_component(sbchildsite)

    #

    # Initialize the widget based on the command line options.

    #

    eval itk_initialize $args

    #

    # When idle, pack the components.

    #

    _packComponents

}

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

#                           DESTRUCTOR

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

body iwidgets::Selectionbox::destructor {} {

    if {$_repacking != ""} {after cancel $_repacking}

}

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

#                             OPTIONS

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

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

# OPTION: -childsitepos

#

# Specifies the position of the child site in the selection box.

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

configbody iwidgets::Selectionbox::childsitepos {

    _packComponents

}

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

# OPTION: -margin

#

# Specifies distance between the items list and selection entry.

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

configbody iwidgets::Selectionbox::margin {

    _packComponents

}

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

# OPTION: -itemson

#

# Specifies whether or not to display the items list.

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

configbody iwidgets::Selectionbox::itemson {

    _packComponents

}

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

# OPTION: -selectionon

#

# Specifies whether or not to display the selection entry widget.

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

configbody iwidgets::Selectionbox::selectionon {

    _packComponents

}

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

# OPTION: -width

#

# Specifies the width of the hull.  The value may be specified in

# any of the forms acceptable to Tk_GetPixels.  A value of zero

# causes the width to be adjusted to the required value based on

# the size requests of the components.  Otherwise, the width is

# fixed.

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

configbody iwidgets::Selectionbox::width {

    #

    # The width option was added to the hull in the constructor.

    # So, any width value given is passed automatically to the

    # hull.  All we have to do is play with the propagation.

    #

    if {$itk_option(-width) != 0} {

        set propagate 0

    } else {

        set propagate 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 $itk_component(hull)] != $propagate} {

        grid propagate $itk_component(hull) $propagate

    }

}

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

# OPTION: -height

#

# Specifies the height of the hull.  The value may be specified in

# any of the forms acceptable to Tk_GetPixels.  A value of zero

# causes the height to be adjusted to the required value based on

# the size requests of the components. Otherwise, the height is

# fixed.

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

configbody iwidgets::Selectionbox::height {

    #

    # The height option was added to the hull in the constructor.

    # So, any height value given is passed automatically to the

    # hull.  All we have to do is play with the propagation.

    #

    if {$itk_option(-height) != 0} {

        set propagate 0

    } else {

        set propagate 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 $itk_component(hull)] != $propagate} {

        grid propagate $itk_component(hull) $propagate

    }

}

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

#                            METHODS

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

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

# METHOD: childsite

#

# Returns the path name of the child site widget.

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

body iwidgets::Selectionbox::childsite {} {

    return $itk_component(sbchildsite)

}

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

# METHOD: get

#

# Returns the current selection.

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

body iwidgets::Selectionbox::get {} {

    return [$itk_component(selection) get]

}

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

# METHOD: curselection

#

# Returns the current selection index.

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

body iwidgets::Selectionbox::curselection {} {

    return [$itk_component(items) curselection]

}

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

# METHOD: clear component

#

# Delete the contents of either the selection entry widget or items

# list.

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

body iwidgets::Selectionbox::clear {component} {

    switch $component {

        selection {

            $itk_component(selection) clear

        }

        items {

            delete 0 end

        }

        default {

            error "bad clear argument \"$component\": should be\

                   selection or items"

        }

    }

}

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

# METHOD: insert component index args

#

# Insert element(s) into either the selection or items list widget.

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

body iwidgets::Selectionbox::insert {component index args} {

    switch $component {

        selection {

            eval $itk_component(selection) insert $index $args

        }

        items {

            eval $itk_component(items) insert $index $args

        }

        default {

            error "bad insert argument \"$component\": should be\

                   selection or items"

        }

    }

}

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

# METHOD: delete first ?last?

#

# Delete one or more elements from the items list box.  The default

# is to delete by indexed range. If an item is to be removed by name,

# it must be preceeded by the keyword "item". Only index numbers can

# be used to delete a range of items.

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

body iwidgets::Selectionbox::delete {first {last {}}} {

    set first [index $first]

    if {$last != {}} {

        set last [index $last]

    } else {

        set last $first

    }

    if {$first <= $last} {

        eval $itk_component(items) delete $first $last

    } else {

        error "first index must not be greater than second"

    }

}

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

# METHOD: size

#

# Returns a decimal string indicating the total number of elements

# in the items list.

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

body iwidgets::Selectionbox::size {} {

    return [$itk_component(items) size]

}

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

# METHOD: scan option args

#

# Implements scanning on items list.

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

body iwidgets::Selectionbox::scan {option args} {

    eval $itk_component(items) scan $option $args

}

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

# METHOD: nearest y

#

# Returns the index to the nearest listbox item given a y coordinate.

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

body iwidgets::Selectionbox::nearest {y} {

    return [$itk_component(items) nearest $y]

}

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

# METHOD: index index

#

# Returns the decimal string giving the integer index corresponding

# to index.

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

body iwidgets::Selectionbox::index {index} {

    return [$itk_component(items) index $index]

}

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

# METHOD: selection option args

#

# Adjusts the selection within the items list.

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

body iwidgets::Selectionbox::selection {option args} {

    eval $itk_component(items) selection $option $args

    selectitem

}

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

# METHOD: selectitem

#

# Replace the selection entry field contents with the currently

# selected items value.

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

body iwidgets::Selectionbox::selectitem {} {

    $itk_component(selection) clear

    set numSelected [$itk_component(items) selecteditemcount]

    if {$numSelected == 1} {

        $itk_component(selection) insert end \

            [$itk_component(items) getcurselection]

    } elseif {$numSelected > 1} {

        $itk_component(selection) insert end \

            [lindex [$itk_component(items) getcurselection] 0]

    }

    $itk_component(selection) icursor end

}

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

# PRIVATE METHOD: _packComponents ?when?

#

# Pack the selection, items, and child site widgets based on options.

# If "when" is "now", the change is applied immediately.  If it is

# "later" or it is not specified, then the change is applied later,

# when the application is idle.

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

body iwidgets::Selectionbox::_packComponents {{when later}} {

    if {$when == "later"} {

        if {$_repacking == ""} {

            set _repacking [after idle [code $this _packComponents now]]

        }

        return

    } elseif {$when != "now"} {

        error "bad option \"$when\": should be now or later"

    }

    set _repacking ""

    set parent [winfo parent $itk_component(sbchildsite)]

    set margin [winfo pixels $itk_component(hull) $itk_option(-margin)]

    switch $itk_option(-childsitepos) {

        n {

            grid $itk_component(sbchildsite) -row 0 -column 0 \

                    -sticky nsew -rowspan 1

            grid $itk_component(items) -row 1 -column 0 -sticky nsew

            grid $itk_component(selection) -row 3 -column 0 -sticky ew

            grid rowconfigure $parent 0 -weight 0 -minsize 0

            grid rowconfigure $parent 1 -weight 1 -minsize 0

            grid rowconfigure $parent 2 -weight 0 -minsize $margin

            grid rowconfigure $parent 3 -weight 0 -minsize 0

            grid columnconfigure $parent 0 -weight 1 -minsize 0

            grid columnconfigure $parent 1 -weight 0 -minsize 0

        }

        w {

            grid $itk_component(sbchildsite) -row 0 -column 0 \

                    -sticky nsew -rowspan 3

            grid $itk_component(items) -row 0 -column 1 -sticky nsew

            grid $itk_component(selection) -row 2 -column 1 -sticky ew

            grid rowconfigure $parent 0 -weight 1 -minsize 0

            grid rowconfigure $parent 1 -weight 0 -minsize $margin

            grid rowconfigure $parent 2 -weight 0 -minsize 0

            grid rowconfigure $parent 3 -weight 0 -minsize 0

            grid columnconfigure $parent 0 -weight 0 -minsize 0

            grid columnconfigure $parent 1 -weight 1 -minsize 0

        }

        s {

            grid $itk_component(items) -row 0 -column 0 -sticky nsew

            grid $itk_component(selection) -row 2 -column 0 -sticky ew

            grid $itk_component(sbchildsite) -row 3 -column 0 \

                    -sticky nsew -rowspan 1

            grid rowconfigure $parent 0 -weight 1 -minsize 0

            grid rowconfigure $parent 1 -weight 0 -minsize $margin

            grid rowconfigure $parent 2 -weight 0 -minsize 0

            grid rowconfigure $parent 3 -weight 0 -minsize 0

            grid columnconfigure $parent 0 -weight 1 -minsize 0

            grid columnconfigure $parent 1 -weight 0 -minsize 0

        }

        e {

            grid $itk_component(items) -row 0 -column 0 -sticky nsew

            grid $itk_component(selection) -row 2 -column 0 -sticky ew

            grid $itk_component(sbchildsite) -row 0 -column 1 \

                    -sticky nsew -rowspan 3

            grid rowconfigure $parent 0 -weight 1 -minsize 0

            grid rowconfigure $parent 1 -weight 0 -minsize $margin

            grid rowconfigure $parent 2 -weight 0 -minsize 0

            grid rowconfigure $parent 3 -weight 0 -minsize 0

            grid columnconfigure $parent 0 -weight 1 -minsize 0

            grid columnconfigure $parent 1 -weight 0 -minsize 0

        }

        center {

            grid $itk_component(items) -row 0 -column 0 -sticky nsew

            grid $itk_component(sbchildsite) -row 1 -column 0 \

                    -sticky nsew -rowspan 1

            grid $itk_component(selection) -row 3 -column 0 -sticky ew

            grid rowconfigure $parent 0 -weight 1 -minsize 0

            grid rowconfigure $parent 1 -weight 0 -minsize 0

            grid rowconfigure $parent 2 -weight 0 -minsize $margin

            grid rowconfigure $parent 3 -weight 0 -minsize 0

            grid columnconfigure $parent 0 -weight 1 -minsize 0

            grid columnconfigure $parent 1 -weight 0 -minsize 0

        }

        default {

            error "bad childsitepos option \"$itk_option(-childsitepos)\":\

                   should be n, e, s, w, or center"

        }

    }

    if {$itk_option(-itemson)} {

    } else {

        grid forget $itk_component(items)

    }

    if {$itk_option(-selectionon)} {

    } else {

        grid forget $itk_component(selection)

    }

    raise $itk_component(sbchildsite)

}