| # |
| # 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: 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] |
| |
| # |
| # 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 "" |
| } |