selectionbox.itk

linux 下的源代码分析阅读器 red hat公司新版

#
# 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: [e-mail]
#
#  @(#) $Id: selectionbox.itk 144 2003-02-05 10:56:26Z mdejong $
# ----------------------------------------------------------------------
#            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.
# ------------------------------------------------------------------