Subversion Repositories or1k_old

#

# 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.1.1.1 2002-01-16 10:24:50 markom 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 -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

# ------------------------------------------------------------------

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 -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 {{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.

# ------------------------------------------------------------------

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"

        }

    }

}

# ------------------------------------------------------------------

# 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

}

# ------------------------------------------------------------------

# 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 ""

}