iwidgets4 4.0.1-6 / usr / share / tcltk / iwidgets4.0.1 / scripts / selectionbox.itk

#
# 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)
}