optionmenu.itk

windows下的GDB insight前端

#
# Optionmenu
# ----------------------------------------------------------------------
# Implements an option menu widget with options to manage it. 
# An option menu displays a frame containing a label and a button.
# A pop-up menu will allow for the value of the button to change. 
#
# ----------------------------------------------------------------------
#  AUTHOR:  Alfredo Jahn             Phone: [phone]
#                                    Email: [e-mail]
#                                           [e-mail]
#
#  @(#) $Id: optionmenu.itk,v 1.9 2001/10/26 15:28:22 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.
# ======================================================================

#
# Default resources.
#

option add *Optionmenu.highlightThickness	1	widgetDefault
option add *Optionmenu.borderWidth		2	widgetDefault
option add *Optionmenu.labelPos			w	widgetDefault
option add *Optionmenu.labelMargin		2	widgetDefault
option add *Optionmenu.popupCursor		arrow	widgetDefault

#
# Usual options.
#
itk::usual Optionmenu {
    keep -activebackground -activeborderwidth -activeforeground \
	 -background -borderwidth -cursor -disabledforeground -font \
	 -foreground -highlightcolor -highlightthickness -labelfont \
	 -popupcursor
}

# ------------------------------------------------------------------
#                            OPTONMENU
# ------------------------------------------------------------------
itcl::class iwidgets::Optionmenu {
    inherit iwidgets::Labeledwidget
    
    constructor {args} {}
    destructor {}

    itk_option define -clicktime clickTime ClickTime 150
    itk_option define -command command Command {}
    itk_option define -cyclicon cyclicOn CyclicOn true
    itk_option define -width width Width 0
    itk_option define -font font Font -Adobe-Helvetica-Bold-R-Normal--*-120-*
    itk_option define -borderwidth borderWidth BorderWidth 2
    itk_option define -highlightthickness highlightThickness HighlightThickness 1
    itk_option define -state state State normal

    public {
      method index {index} 
      method delete {first {last {}}} 
      method disable {index} 
      method enable {args} 
      method get {{first "current"} {last ""}} 
      method insert {index string args} 
      method popupMenu {args} 
      method select {index} 
      method sort {{mode "increasing"}} 
    }

    protected {
      variable _calcSize ""  ;# non-null => _calcSize pending
    }

    private {
      method _buttonRelease {time} 
      method _getNextItem {index} 
      method _next {} 
      method _postMenu {time} 
      method _previous {} 
      method _setItem {item} 
      method _setSize {{when later}} 
      method _setitems {items} ;# Set the list of menu entries

      variable _postTime 0
      variable _items {}       ;# List of popup menu entries
      variable _numitems 0     ;# List of popup menu entries

      variable _currentItem "" ;# Active menu selection
    }
}

#
# Provide a lowercased access method for the Optionmenu class.
# 
proc ::iwidgets::optionmenu {pathName args} {
    uplevel ::iwidgets::Optionmenu $pathName $args
}

# ------------------------------------------------------------------
#                        CONSTRUCTOR
# ------------------------------------------------------------------
itcl::body iwidgets::Optionmenu::constructor {args} {
    global tcl_platform

    component hull configure -highlightthickness 0

    itk_component add menuBtn {
	menubutton $itk_interior.menuBtn -relief raised -indicatoron on \
            -textvariable [itcl::scope _currentItem] -takefocus 1 \
            -menu $itk_interior.menuBtn.menu
    } {
        usual
	keep -borderwidth
        if {$tcl_platform(platform) != "unix"} {
            ignore -activebackground -activeforeground
        }
    }
    pack $itk_interior.menuBtn -fill x
    pack propagate $itk_interior no

    itk_component add popupMenu {
	menu $itk_interior.menuBtn.menu -tearoff no
    } {
	usual
	ignore -tearoff
	keep -activeborderwidth -borderwidth
	rename -cursor -popupcursor popupCursor Cursor
    }

    #
    # Bind to button release for all components.
    #
    bind $itk_component(menuBtn) <ButtonPress-1> \
	    "[itcl::code $this _postMenu %t]; break"
    bind $itk_component(menuBtn) <KeyPress-space> \
	    "[itcl::code $this _postMenu %t]; break"
    bind $itk_component(popupMenu) <ButtonRelease-1> \
	    [itcl::code $this _buttonRelease %t]

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

# ------------------------------------------------------------------
#                           DESTRUCTOR
# ------------------------------------------------------------------
itcl::body iwidgets::Optionmenu::destructor {} {
    if {$_calcSize != ""} {after cancel $_calcSize}
}

# ------------------------------------------------------------------
#                             OPTIONS
# ------------------------------------------------------------------

# ------------------------------------------------------------------
# OPTION -clicktime
#
# Interval time (in msec) used to determine that a single mouse 
# click has occurred. Used to post menu on a quick mouse click.
# **WARNING** changing this value may cause the sigle-click 
# functionality to not work properly!
# ------------------------------------------------------------------
itcl::configbody iwidgets::Optionmenu::clicktime {}

# ------------------------------------------------------------------
# OPTION -command
#
# Specifies a command to be evaluated upon change in option menu.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Optionmenu::command {}

# ------------------------------------------------------------------
# OPTION -cyclicon
#
# Turns on/off the 3rd mouse button capability. This feature
# allows the right mouse button to cycle through the popup 
# menu list without poping it up. <shift>M3 cycles through
# the menu in reverse order.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Optionmenu::cyclicon {
    if {$itk_option(-cyclicon)} {
    	bind $itk_component(menuBtn) <3> [itcl::code $this _next]
    	bind $itk_component(menuBtn) <Shift-3> [itcl::code $this _previous]
        bind $itk_component(menuBtn) <KeyPress-Down> [itcl::code $this _next]
        bind $itk_component(menuBtn) <KeyPress-Up> [itcl::code $this _previous]
    } else {
    	bind $itk_component(menuBtn) <3> break
    	bind $itk_component(menuBtn) <Shift-3> break
        bind $itk_component(menuBtn) <KeyPress-Down> break
        bind $itk_component(menuBtn) <KeyPress-Up> break
    }
}

# ------------------------------------------------------------------
# OPTION -width
#
# Allows the menu label width to be set to a fixed size
# ------------------------------------------------------------------
itcl::configbody iwidgets::Optionmenu::width {
    _setSize
}

# ------------------------------------------------------------------
# OPTION -font
#
# Change all fonts for this widget. Also re-calculate height based
# on font size (used to line up menu items over menu button label).
# ------------------------------------------------------------------
itcl::configbody iwidgets::Optionmenu::font {
    _setSize
}

# ------------------------------------------------------------------
# OPTION -borderwidth
#
# Change borderwidth for this widget. Also re-calculate height based
# on font size (used to line up menu items over menu button label).
# ------------------------------------------------------------------
itcl::configbody iwidgets::Optionmenu::borderwidth {
    _setSize
}

# ------------------------------------------------------------------
# OPTION -highlightthickness
#
# Change highlightthickness for this widget. Also re-calculate
# height based on font size (used to line up menu items over
# menu button label).
# ------------------------------------------------------------------
itcl::configbody iwidgets::Optionmenu::highlightthickness {
    _setSize
}

# ------------------------------------------------------------------
# OPTION -state
#
# Specified one of two states for the Optionmenu: normal, or
# disabled.  If the Optionmenu is disabled, then option menu
# selection is ignored.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Optionmenu::state {
    switch $itk_option(-state) {
    	normal {
            $itk_component(menuBtn) config -state normal
            $itk_component(label) config -fg $itk_option(-foreground)
    	} 
    	disabled {
            $itk_component(menuBtn) config -state disabled
            $itk_component(label) config -fg $itk_option(-disabledforeground)
    	}
    	default {
    	    error "bad state option \"$itk_option(-state)\":\
		    should be disabled or normal"
    	}
    }
}

# ------------------------------------------------------------------
#                            METHODS
# ------------------------------------------------------------------

# ------------------------------------------------------------------
# METHOD: index index
#
# Return the numerical index corresponding to index.
# ------------------------------------------------------------------
itcl::body iwidgets::Optionmenu::index {index} {

    if {[regexp {(^[0-9]+$)} $index]} {
	set idx [$itk_component(popupMenu) index $index]

	if {$idx == "none"} {
	    return 0
	}
	return [expr {$index > $idx ? $_numitems : $idx}]
	
    } elseif {$index == "end"} {
	return [expr {$_numitems - 1}]
	
    } elseif {$index == "select"} {
	return [lsearch $_items $_currentItem]
	
    }

    set numValue [lsearch -glob $_items $index]

    if {$numValue == -1} {
        error "bad Optionmenu index \"$index\""
    }
    return $numValue
}

# ------------------------------------------------------------------
# METHOD: delete first ?last?
#
# Remove an item (or range of items) from the popup menu. 
# ------------------------------------------------------------------
itcl::body iwidgets::Optionmenu::delete {first {last {}}} {

    set first [index $first]
    set last [expr {$last != {} ? [index $last] : $first}]    
    set nextAvail $_currentItem
    
    #
    # If current item is in delete range point to next available.
    #
    if {$_numitems > 1 &&
	([lsearch -exact [lrange $_items $first $last] [get]] != -1)} {
	set nextAvail [_getNextItem $last]
    }
    
    _setitems [lreplace $_items $first $last]