| # Spinint |
| # ---------------------------------------------------------------------- |
| # Implements an integer spinner widget. It inherits basic spinner |
| # functionality from Spinner and adds specific features to create |
| # an integer-only spinner. |
| # Arrows may be placed horizontally or vertically. |
| # User may specify an integer range and step value. |
| # Spinner may be configured to wrap when min or max value is reached. |
| # |
| # NOTE: |
| # Spinint integer values should not exceed the size of a long integer. |
| # For a 32 bit long the integer range is -2147483648 to 2147483647. |
| # |
| # ---------------------------------------------------------------------- |
| # AUTHOR: Sue Yockey Phone: (214) 519-2517 |
| # E-mail: syockey@spd.dsccc.com |
| # yockey@acm.org |
| # |
| # @(#) $Id: spinint.itk,v 1.3 2001/08/07 19:56:48 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. |
| # ====================================================================== |
| |
| # |
| # Usual options. |
| # |
| itk::usual Spinint { |
| keep -background -borderwidth -cursor -foreground -highlightcolor \ |
| -highlightthickness -insertbackground -insertborderwidth \ |
| -insertofftime -insertontime -insertwidth -labelfont \ |
| -selectbackground -selectborderwidth -selectforeground \ |
| -textbackground -textfont |
| } |
| |
| # ------------------------------------------------------------------ |
| # SPININT |
| # ------------------------------------------------------------------ |
| itcl::class iwidgets::Spinint { |
| inherit iwidgets::Spinner |
| |
| constructor {args} { |
| Spinner::constructor -validate numeric |
| } {} |
| |
| itk_option define -range range Range "" |
| itk_option define -step step Step 1 |
| itk_option define -wrap wrap Wrap true |
| |
| public method up {} |
| public method down {} |
| } |
| |
| # |
| # Provide a lowercased access method for the Spinint class. |
| # |
| proc ::iwidgets::spinint {pathName args} { |
| uplevel ::iwidgets::Spinint $pathName $args |
| } |
| |
| # ------------------------------------------------------------------ |
| # CONSTRUCTOR |
| # ------------------------------------------------------------------ |
| itcl::body iwidgets::Spinint::constructor {args} { |
| eval itk_initialize $args |
| |
| $itk_component(entry) delete 0 end |
| |
| if {[lindex $itk_option(-range) 0] == ""} { |
| $itk_component(entry) insert 0 "0" |
| } else { |
| $itk_component(entry) insert 0 [lindex $itk_option(-range) 0] |
| } |
| } |
| |
| # ------------------------------------------------------------------ |
| # OPTIONS |
| # ------------------------------------------------------------------ |
| |
| # ------------------------------------------------------------------ |
| # OPTION: -range |
| # |
| # Set min and max values for spinner. |
| # ------------------------------------------------------------------ |
| itcl::configbody iwidgets::Spinint::range { |
| if {$itk_option(-range) != ""} { |
| if {[llength $itk_option(-range)] != 2} { |
| error "wrong # args: should be\ |
| \"$itk_component(hull) configure -range {begin end}\"" |
| } |
| |
| set min [lindex $itk_option(-range) 0] |
| set max [lindex $itk_option(-range) 1] |
| |
| if {![regexp {^-?[0-9]+$} $min]} { |
| error "bad range option \"$min\": begin value must be\ |
| an integer" |
| } |
| if {![regexp {^-?[0-9]+$} $max]} { |
| error "bad range option \"$max\": end value must be\ |
| an integer" |
| } |
| if {$min > $max} { |
| error "bad option starting range \"$min\": must be less\ |
| than ending: \"$max\"" |
| } |
| } |
| } |
| |
| # ------------------------------------------------------------------ |
| # OPTION: -step |
| # |
| # Increment spinner by step value. |
| # ------------------------------------------------------------------ |
| itcl::configbody iwidgets::Spinint::step { |
| } |
| |
| # ------------------------------------------------------------------ |
| # OPTION: -wrap |
| # |
| # Specify whether spinner should wrap value if at min or max. |
| # ------------------------------------------------------------------ |
| itcl::configbody iwidgets::Spinint::wrap { |
| } |
| |
| # ------------------------------------------------------------------ |
| # METHODS |
| # ------------------------------------------------------------------ |
| |
| # ------------------------------------------------------------------ |
| # METHOD: up |
| # |
| # Up arrow button press event. Increment value in entry. |
| # ------------------------------------------------------------------ |
| itcl::body iwidgets::Spinint::up {} { |
| set min_range [lindex $itk_option(-range) 0] |
| set max_range [lindex $itk_option(-range) 1] |
| |
| set val [$itk_component(entry) get] |
| if {[lindex $itk_option(-range) 0] != ""} { |
| |
| # |
| # Check boundaries. |
| # |
| if {$val >= $min_range && $val < $max_range} { |
| incr val $itk_option(-step) |
| $itk_component(entry) delete 0 end |
| $itk_component(entry) insert 0 $val |
| } else { |
| if {$itk_option(-wrap)} { |
| if {$val >= $max_range} { |
| $itk_component(entry) delete 0 end |
| $itk_component(entry) insert 0 $min_range |
| } elseif {$val < $min_range} { |
| $itk_component(entry) delete 0 end |
| $itk_component(entry) insert 0 $min_range |
| } else { |
| uplevel #0 $itk_option(-invalid) |
| } |
| } else { |
| uplevel #0 $itk_option(-invalid) |
| } |
| } |
| } else { |
| |
| # |
| # No boundaries. |
| # |
| incr val $itk_option(-step) |
| $itk_component(entry) delete 0 end |
| $itk_component(entry) insert 0 $val |
| } |
| } |
| |
| # ------------------------------------------------------------------ |
| # METHOD: down |
| # |
| # Down arrow button press event. Decrement value in entry. |
| # ------------------------------------------------------------------ |
| itcl::body iwidgets::Spinint::down {} { |
| set min_range [lindex $itk_option(-range) 0] |
| set max_range [lindex $itk_option(-range) 1] |
| |
| set val [$itk_component(entry) get] |
| if {[lindex $itk_option(-range) 0] != ""} { |
| |
| # |
| # Check boundaries. |
| # |
| if {$val > $min_range && $val <= $max_range} { |
| incr val -$itk_option(-step) |
| $itk_component(entry) delete 0 end |
| $itk_component(entry) insert 0 $val |
| } else { |
| if {$itk_option(-wrap)} { |
| if {$val <= $min_range} { |
| $itk_component(entry) delete 0 end |
| $itk_component(entry) insert 0 $max_range |
| } elseif {$val > $max_range} { |
| $itk_component(entry) delete 0 end |
| $itk_component(entry) insert 0 $max_range |
| } else { |
| uplevel #0 $itk_option(-invalid) |
| } |
| } else { |
| uplevel #0 $itk_option(-invalid) |
| } |
| } |
| } else { |
| |
| # |
| # No boundaries. |
| # |
| incr val -$itk_option(-step) |
| $itk_component(entry) delete 0 end |
| $itk_component(entry) insert 0 $val |
| } |
| } |