imported itcl 3.2.1ITCL3_2_1

1 files changed, 664 insertions, 0 deletions

diff --git a/itcl/iwidgets/generic/optionmenu.itk b/itcl/iwidgets/generic/optionmenu.itk
new file mode 100644
index 00000000000..ddb3995fd41
--- /dev/null
+++ b/itcl/iwidgets/generic/optionmenu.itk
@@ -0,0 +1,664 @@
+#
+# 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: (214) 519-3545
+#                                    Email: ajahn@spd.dsccc.com
+#                                           alfredo@wn.com
+#
+#  @(#) $Id$
+# ----------------------------------------------------------------------
+#            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]
+    
+    #
+    # Make sure "nextAvail" is still in the list.
+    #
+    set index [lsearch -exact $_items $nextAvail]
+    _setItem [expr {$index != -1 ? $nextAvail : ""}]
+}
+
+# ------------------------------------------------------------------
+# METHOD: disable index
+#
+# Disable a menu item in the option menu.  This will prevent the user
+# from being able to select this item from the menu.  This only effects
+# the state of the item in the menu, in other words, should the item
+# be the currently selected item, the user is responsible for 
+# determining this condition and taking appropriate action.
+# ------------------------------------------------------------------
+itcl::body iwidgets::Optionmenu::disable {index} {
+    set index [index $index]
+    $itk_component(popupMenu) entryconfigure $index -state disabled
+}
+
+# ------------------------------------------------------------------
+# METHOD: enable index
+#
+# Enable a menu item in the option menu.  This will allow the user
+# to select this item from the menu.  
+# ------------------------------------------------------------------
+itcl::body iwidgets::Optionmenu::enable {index} {
+    set index [index $index]
+    $itk_component(popupMenu) entryconfigure $index -state normal
+}
+
+# ------------------------------------------------------------------
+# METHOD: get
+#
+# Returns the current menu item.
+# ------------------------------------------------------------------
+itcl::body iwidgets::Optionmenu::get {{first "current"} {last ""}} {
+    if {"current" == $first} {
+        return $_currentItem
+    }
+
+    set first [index $first]
+    if {"" == $last} {
+        return [$itk_component(popupMenu) entrycget $first -label]
+    }
+
+    if {"end" == $last} {
+        set last [$itk_component(popupMenu) index end]
+    } else {
+        set last [index $last]
+    }
+    set rval ""
+    while {$first <= $last} {
+        lappend rval [$itk_component(popupMenu) entrycget $first -label]
+        incr first
+    }
+    return $rval
+}
+
+# ------------------------------------------------------------------
+# METHOD: insert index string ?string?
+#
+# Insert an item in the popup menu.
+# ------------------------------------------------------------------
+itcl::body iwidgets::Optionmenu::insert {index string args} {
+    if {$index == "end"} {
+	set index $_numitems
+    } else {
+	set index [index $index]
+    }
+    set args [linsert $args 0 $string]
+    _setitems [eval linsert {$_items} $index $args]
+    return ""
+}
+
+# ------------------------------------------------------------------
+# METHOD: select index
+#
+# Select an item from the popup menu to display on the menu label
+# button. 
+# ------------------------------------------------------------------
+itcl::body iwidgets::Optionmenu::select {index} {
+    set index [index $index]
+    if {$index > ($_numitems - 1)} {
+      incr index -1 
+    }
+    _setItem [lindex $_items $index]
+}
+
+# ------------------------------------------------------------------
+# METHOD: popupMenu
+#
+# Evaluates the specified args against the popup menu component
+# and returns the result.
+# ------------------------------------------------------------------
+itcl::body iwidgets::Optionmenu::popupMenu {args} {
+    return [eval $itk_component(popupMenu) $args]	
+}
+
+# ------------------------------------------------------------------
+# METHOD: sort mode
+#
+# Sort the current menu in either "ascending" or "descending" order.
+# ------------------------------------------------------------------
+itcl::body iwidgets::Optionmenu::sort {{mode "increasing"}} {
+    switch $mode {
+	ascending -
+	increasing {
+	    _setitems [lsort -increasing $_items]
+	}
+	descending -
+	decreasing {
+	    _setitems [lsort -decreasing $_items]
+	}
+	default {
+	    error "bad sort argument \"$mode\": should be ascending,\
+		    descending, increasing, or decreasing"
+	}
+    }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _buttonRelease
+#
+# Display the popup menu. Menu position is calculated.
+# ------------------------------------------------------------------
+itcl::body iwidgets::Optionmenu::_buttonRelease {time} {
+    if {(abs([expr $_postTime - $time])) <= $itk_option(-clicktime)} {
+        return -code break
+    }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _getNextItem index
+#
+# Allows either a string or index number to be passed in, and returns
+# the next item in the list in string format. Wrap around is automatic.
+# ------------------------------------------------------------------
+itcl::body iwidgets::Optionmenu::_getNextItem {index} {
+
+    if {[incr index] >= $_numitems} {
+	set index 0   ;# wrap around
+    }
+    return [lindex $_items $index]
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _next
+#
+# Sets the current option label to next item in list if that item is
+# not disbaled.
+# ------------------------------------------------------------------
+itcl::body iwidgets::Optionmenu::_next {} {
+    if {$itk_option(-state) != "normal"} {
+        return
+    }
+    set i [lsearch -exact $_items $_currentItem]
+	
+    for {set cnt 0} {$cnt < $_numitems} {incr cnt} {
+
+        if {[incr i] >= $_numitems} {
+            set i 0
+        }
+	    
+        if {[$itk_component(popupMenu) entrycget $i -state] != "disabled"} {
+            _setItem [lindex $_items $i]
+            break
+        }
+    }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _previous
+#
+# Sets the current option label to previous item in list if that 
+# item is not disbaled.
+# ------------------------------------------------------------------
+itcl::body iwidgets::Optionmenu::_previous {} {
+    if {$itk_option(-state) != "normal"} {
+        return
+    }
+
+    set i [lsearch -exact $_items $_currentItem]
+	
+    for {set cnt 0} {$cnt < $_numitems} {incr cnt} {
+	set i [expr {$i - 1}]
+    
+	if {$i < 0} {
+	    set i [expr {$_numitems - 1}]
+	}
+
+	if {[$itk_component(popupMenu) entrycget $i -state] != "disabled"} {
+	    _setItem [lindex $_items $i]
+	    break
+	}
+    }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _postMenu time
+#
+# Display the popup menu. Menu position is calculated.
+# ------------------------------------------------------------------
+itcl::body iwidgets::Optionmenu::_postMenu {time} {
+    #
+    # Don't bother to post if menu is empty.
+    #
+    if {[llength $_items] > 0 && $itk_option(-state) == "normal"} {
+        set _postTime $time
+        set itemIndex [lsearch -exact $_items $_currentItem]
+
+        set margin [expr {$itk_option(-borderwidth) \
+            + $itk_option(-highlightthickness)}]
+
+        set x [expr {[winfo rootx $itk_component(menuBtn)] + $margin}]
+        set y [expr {[winfo rooty $itk_component(menuBtn)] \
+            - [$itk_component(popupMenu) yposition $itemIndex] + $margin}]
+
+        tk_popup $itk_component(popupMenu) $x $y
+    }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _setItem
+#
+# Set the menu button label to item, then dismiss the popup menu.
+# Also check if item has been changed. If so, also call user-supplied
+# command.
+# ------------------------------------------------------------------
+itcl::body iwidgets::Optionmenu::_setItem {item} {
+    if {$_currentItem != $item} {
+        set _currentItem $item
+	if {[winfo ismapped $itk_component(hull)]} {
+	    uplevel #0 $itk_option(-command)
+	}
+    }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _setitems items
+#
+# Create a list of items available on the menu. Used to create the
+# popup menu.
+# ------------------------------------------------------------------
+itcl::body iwidgets::Optionmenu::_setitems {items_} {
+
+    #
+    # Delete the old menu entries, and set the new list of
+    # menu entries to those specified in "items_".
+    #
+    $itk_component(popupMenu) delete 0 last
+    set _items ""
+    set _numitems [llength $items_]
+
+    #
+    # Clear the menu button label.
+    #
+    if {$_numitems == 0} {
+	_setItem ""
+	return
+    }
+
+    set savedCurrentItem $_currentItem
+	
+    foreach opt $items_ {
+        lappend _items $opt
+        $itk_component(popupMenu) add command -label $opt \
+            -command [itcl::code $this _setItem $opt]
+    }
+    set first [lindex $_items 0]
+	
+    #
+    # Make sure "savedCurrentItem" is still in the list.
+    #
+    if {$first != ""} {
+        set i [lsearch -exact $_items $savedCurrentItem]
+	#-------------------------------------------------------------
+	# BEGIN BUG FIX: csmith (Chad Smith: csmith@adc.com), 11/18/99
+	#-------------------------------------------------------------
+	# The previous code fragment:
+	#   <select [expr {$i != -1 ? $savedCurrentItem : $first}]>
+	# is faulty because of exponential numbers.  For example,
+	# 2e-4 is numerically equal to 2e-04, but the string representation
+	# is of course different.  As a result, the select invocation
+	# fails, and an error message is printed.
+	#-------------------------------------------------------------
+	if {$i != -1} {
+	  select $savedCurrentItem
+	} else {
+	  select $first
+	}
+	#-------------------------------------------------------------
+	# END BUG FIX
+	#-------------------------------------------------------------
+    } else {
+	_setItem ""
+    }
+
+    _setSize
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _setSize ?when?
+#
+# Set the size of the option menu.  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::Optionmenu::_setSize {{when later}} {
+
+    if {$when == "later"} {
+	if {$_calcSize == ""} {
+	    set _calcSize [after idle [itcl::code $this _setSize now]]
+	}
+	return
+    }
+
+    set margin [expr {2*($itk_option(-borderwidth) \
+        + $itk_option(-highlightthickness))}]
+
+    if {"0" != $itk_option(-width)} {
+    	set width $itk_option(-width)
+    } else {
+	set width [expr {[winfo reqwidth $itk_component(popupMenu)]+$margin+20}]
+    }
+    set height [winfo reqheight $itk_component(menuBtn)]
+    $itk_component(lwchildsite) configure -width $width -height $height
+
+    set _calcSize ""
+}