scrolledlistbox.itk

windows下的GDB insight前端

#
# 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: [e-mail]
#
#  @(#) $Id: scrolledlistbox.itk,v 1.9 2002/03/16 16:25:44 mgbacke 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
# ------------------------------------------------------------------
itcl::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 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} 
    public method itemconfigure {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 { \
    <Double-1> 
    }

    common singleSelectSeq { \
        <Control-Key-backslash> \
    <Control-Key-slash> \
    <Key-Escape> \
    <Shift-Key-Select> \
    <Control-Shift-Key-space> \
    <Key-Select> \
    <Key-space> \
    <Control-Shift-Key-End> \
    <Control-Key-End> \
    <Control-Shift-Key-Home> \
    <Control-Key-Home> \
    <Key-Down> \
    <Key-Up> \
    <Shift-Key-Down> \
    <Shift-Key-Up> \
    <Control-Button-1> \
    <Shift-Button-1> \
    <ButtonRelease-1> \
    }
}

#
# 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
# ------------------------------------------------------------------
itcl::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 \
        [itcl::code $this _scrollWidget $itk_interior.horizsb] \
        -yscrollcommand \
        [itcl::code $this _scrollWidget $itk_interior.vertsb]
    } {
    usual

    keep -borderwidth -exportselection -relief -selectmode
    keep -listvariable
    
    rename -font -textfont textFont Font
    rename -background -textbackground textBackground Background
    rename -highlightbackground -background background Background
    }
    grid $itk_component(listbox) -row 0 -column 0 -sticky nsew
    grid rowconfigure $_interior 0 -weight 1
    grid columnconfigure $_interior 0 -weight 1
    
    # 
    # Configure the command on the vertical scroll bar in the base class.
    #
    $itk_component(vertsb) configure \
    -command [itcl::code $itk_component(listbox) yview]

    #
    # Configure the command on the horizontal scroll bar in the base class.
    #
    $itk_component(horizsb) configure \
        -command [itcl::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 [itcl::code $this _makeSelection]
    }

    foreach seq $doubleSelectSeq {
        bind SLBSelect$this $seq [itcl::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 <Button-1> break

        foreach seq $doubleSelectSeq {
            bind SLBDisabled $seq break
        }
    }

    #
    # Initialize the widget based on the command line options.
    #
    eval itk_initialize $args
}

# ------------------------------------------------------------------
#                           DESTURCTOR
# ------------------------------------------------------------------
itcl::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
# ------------------------------------------------------------------
itcl::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..
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
    #