# # 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.3 2006/09/11 20:35:55 irby 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 # ------------------------------------------------------------------ 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 -items items Items "" 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 {} 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 # ------------------------------------------------------------------ body iwidgets::Optionmenu::constructor {args} { global tcl_platform component hull configure -highlightthickness 0 itk_component add menuBtn { menubutton $itk_interior.menuBtn -relief raised -indicator on \ -textvariable [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) \ "[code $this _postMenu %t]; break" bind $itk_component(menuBtn) \ "[code $this _postMenu %t]; break" bind $itk_component(popupMenu) \ [code $this _buttonRelease %t] # # Initialize the widget based on the command line options. # eval itk_initialize $args } # ------------------------------------------------------------------ # DESTRUCTOR # ------------------------------------------------------------------ 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! # ------------------------------------------------------------------ configbody iwidgets::Optionmenu::clicktime {} # ------------------------------------------------------------------ # OPTION -command # # Specifies a command to be evaluated upon change in option menu. # ------------------------------------------------------------------ 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. M3 cycles through # the menu in reverse order. # ------------------------------------------------------------------ configbody iwidgets::Optionmenu::cyclicon { if {$itk_option(-cyclicon)} { bind $itk_component(menuBtn) <3> [code $this _next] bind $itk_component(menuBtn) [code $this _previous] bind $itk_component(menuBtn) [code $this _next] bind $itk_component(menuBtn) [code $this _previous] } else { bind $itk_component(menuBtn) <3> break bind $itk_component(menuBtn) break bind $itk_component(menuBtn) break bind $itk_component(menuBtn) break } } # ------------------------------------------------------------------ # OPTION -width # # Allows the menu label width to be set to a fixed size # ------------------------------------------------------------------ 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). # ------------------------------------------------------------------ configbody iwidgets::Optionmenu::font { _setSize } # ------------------------------------------------------------------ # OPTION -items # # Create a list of items available on the menu. Used to create the # popup menu. # ------------------------------------------------------------------ configbody iwidgets::Optionmenu::items { _setitems $itk_option(-items) } # ------------------------------------------------------------------ # 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). # ------------------------------------------------------------------ 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). # ------------------------------------------------------------------ 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. # ------------------------------------------------------------------ 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. # ------------------------------------------------------------------ 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 $_numitems } 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. # ------------------------------------------------------------------ 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. # ------------------------------------------------------------------ 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. # ------------------------------------------------------------------ body iwidgets::Optionmenu::enable {index} { set index [index $index] $itk_component(popupMenu) entryconfigure $index -state normal } # ------------------------------------------------------------------ # METHOD: get # # Returns the current menu item. # ------------------------------------------------------------------ body iwidgets::Optionmenu::get {} { return $_currentItem } # ------------------------------------------------------------------ # METHOD: insert index string ?string? # # Insert an item in the popup menu. # ------------------------------------------------------------------ body iwidgets::Optionmenu::insert {index string args} { 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. # ------------------------------------------------------------------ body iwidgets::Optionmenu::select {index} { set index [index $index] _setItem [lindex $_items $index] } # ------------------------------------------------------------------ # METHOD: popupMenu # # Evaluates the specified args against the popup menu component # and returns the result. # ------------------------------------------------------------------ body iwidgets::Optionmenu::popupMenu {args} { return [eval $itk_component(popupMenu) $args] } # ------------------------------------------------------------------ # METHOD: sort mode # # Sort the current menu in either "ascending" or "descending" order. # ------------------------------------------------------------------ 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" } } return "" } # ------------------------------------------------------------------ # PRIVATE METHOD: _buttonRelease # # Display the popup menu. Menu position is calculated. # ------------------------------------------------------------------ body iwidgets::Optionmenu::_buttonRelease {time} { if {[expr 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. # ------------------------------------------------------------------ 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. # ------------------------------------------------------------------ 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. # ------------------------------------------------------------------ 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. # ------------------------------------------------------------------ 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. # ------------------------------------------------------------------ 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. # ------------------------------------------------------------------ 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 [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] select [expr {$i != -1 ? $savedCurrentItem : $first}] } else { _setItem "" } _setSize set itk_option(-items) $_items } # ------------------------------------------------------------------ # 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. # ------------------------------------------------------------------ body iwidgets::Optionmenu::_setSize {{when later}} { if {$when == "later"} { if {$_calcSize == ""} { set _calcSize [after idle [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 "" }