diff options
Diffstat (limited to 'iwidgets/generic/optionmenu.itk')
| -rw-r--r-- | iwidgets/generic/optionmenu.itk | 664 |
1 files changed, 664 insertions, 0 deletions
diff --git a/iwidgets/generic/optionmenu.itk b/iwidgets/generic/optionmenu.itk new file mode 100644 index 00000000000..ddb3995fd41 --- /dev/null +++ b/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 "" +} |