You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
561 lines
19 KiB
Plaintext
561 lines
19 KiB
Plaintext
#
|
|
# 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.2 2001/08/07 19:56:48 smithc 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
|
|
# ------------------------------------------------------------------
|
|
itcl::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
|
|
# ------------------------------------------------------------------
|
|
itcl::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 [itcl::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
|
|
# ------------------------------------------------------------------
|
|
itcl::body iwidgets::Selectionbox::destructor {} {
|
|
if {$_repacking != ""} {after cancel $_repacking}
|
|
}
|
|
|
|
# ------------------------------------------------------------------
|
|
# OPTIONS
|
|
# ------------------------------------------------------------------
|
|
|
|
# ------------------------------------------------------------------
|
|
# OPTION: -childsitepos
|
|
#
|
|
# Specifies the position of the child site in the selection box.
|
|
# ------------------------------------------------------------------
|
|
itcl::configbody iwidgets::Selectionbox::childsitepos {
|
|
_packComponents
|
|
}
|
|
|
|
# ------------------------------------------------------------------
|
|
# OPTION: -margin
|
|
#
|
|
# Specifies distance between the items list and selection entry.
|
|
# ------------------------------------------------------------------
|
|
itcl::configbody iwidgets::Selectionbox::margin {
|
|
_packComponents
|
|
}
|
|
|
|
# ------------------------------------------------------------------
|
|
# OPTION: -itemson
|
|
#
|
|
# Specifies whether or not to display the items list.
|
|
# ------------------------------------------------------------------
|
|
itcl::configbody iwidgets::Selectionbox::itemson {
|
|
_packComponents
|
|
}
|
|
|
|
# ------------------------------------------------------------------
|
|
# OPTION: -selectionon
|
|
#
|
|
# Specifies whether or not to display the selection entry widget.
|
|
# ------------------------------------------------------------------
|
|
itcl::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.
|
|
# ------------------------------------------------------------------
|
|
itcl::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.
|
|
# ------------------------------------------------------------------
|
|
itcl::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.
|
|
# ------------------------------------------------------------------
|
|
itcl::body iwidgets::Selectionbox::childsite {} {
|
|
return $itk_component(sbchildsite)
|
|
}
|
|
|
|
# ------------------------------------------------------------------
|
|
# METHOD: get
|
|
#
|
|
# Returns the current selection.
|
|
# ------------------------------------------------------------------
|
|
itcl::body iwidgets::Selectionbox::get {} {
|
|
return [$itk_component(selection) get]
|
|
}
|
|
|
|
# ------------------------------------------------------------------
|
|
# METHOD: curselection
|
|
#
|
|
# Returns the current selection index.
|
|
# ------------------------------------------------------------------
|
|
itcl::body iwidgets::Selectionbox::curselection {} {
|
|
return [$itk_component(items) curselection]
|
|
}
|
|
|
|
# ------------------------------------------------------------------
|
|
# METHOD: clear component
|
|
#
|
|
# Delete the contents of either the selection entry widget or items
|
|
# list.
|
|
# ------------------------------------------------------------------
|
|
itcl::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.
|
|
# ------------------------------------------------------------------
|
|
itcl::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.
|
|
# ------------------------------------------------------------------
|
|
itcl::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.
|
|
# ------------------------------------------------------------------
|
|
itcl::body iwidgets::Selectionbox::size {} {
|
|
return [$itk_component(items) size]
|
|
}
|
|
|
|
# ------------------------------------------------------------------
|
|
# METHOD: scan option args
|
|
#
|
|
# Implements scanning on items list.
|
|
# ------------------------------------------------------------------
|
|
itcl::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.
|
|
# ------------------------------------------------------------------
|
|
itcl::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.
|
|
# ------------------------------------------------------------------
|
|
itcl::body iwidgets::Selectionbox::index {index} {
|
|
return [$itk_component(items) index $index]
|
|
}
|
|
|
|
# ------------------------------------------------------------------
|
|
# METHOD: selection option args
|
|
#
|
|
# Adjusts the selection within the items list.
|
|
# ------------------------------------------------------------------
|
|
itcl::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.
|
|
# ------------------------------------------------------------------
|
|
itcl::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.
|
|
# ------------------------------------------------------------------
|
|
itcl::body iwidgets::Selectionbox::_packComponents {{when later}} {
|
|
if {$when == "later"} {
|
|
if {$_repacking == ""} {
|
|
set _repacking [after idle [itcl::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)
|
|
}
|
|
|