neingeist
/
arduinisten
Archived
1
0
Fork 0
You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
This repo is archived. You can view files and clone it, but cannot push or open issues/pull-requests.

428 lines
15 KiB
Plaintext

#
# Radiobox
# ----------------------------------------------------------------------
# Implements a radiobuttonbox. Supports adding, inserting, deleting,
# selecting, and deselecting of radiobuttons by tag and index.
#
# ----------------------------------------------------------------------
# AUTHOR: Michael J. McLennan EMAIL: mmclennan@lucent.com
# Mark L. Ulferts EMAIL: mulferts@austin.dsccc.com
#
# @(#) $Id: radiobox.itk,v 1.8 2002/02/27 05:59:07 mgbacke 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 Radiobox {
keep -background -borderwidth -cursor -disabledforeground \
-foreground -labelfont -selectcolor
}
# ------------------------------------------------------------------
# RADIOBOX
# ------------------------------------------------------------------
itcl::class iwidgets::Radiobox {
inherit iwidgets::Labeledframe
constructor {args} {}
destructor {}
itk_option define -disabledforeground \
disabledForeground DisabledForeground {}
itk_option define -selectcolor selectColor Background {}
itk_option define -command command Command {}
itk_option define -orient orient Orient vertical
public {
method add {tag args}
method buttonconfigure {index args}
method component {{name ""} args}
method delete {index}
method deselect {index}
method flash {index}
method get {}
method index {index}
method insert {index tag args}
method select {index}
}
protected method _command { name1 name2 opt }
private {
method gettag {index} ;# Get the tag of the checkbutton associated
;# with a numeric index
method _rearrange {} ;# List of radiobutton tags.
variable _buttons {} ;# List of radiobutton tags.
common _modes ;# Current selection.
variable _unique 0 ;# Unique id for choice creation.
}
}
#
# Provide a lowercased access method for the Radiobox class.
#
proc ::iwidgets::radiobox {pathName args} {
uplevel ::iwidgets::Radiobox $pathName $args
}
#
# Use option database to override default resources of base classes.
#
option add *Radiobox.labelMargin 10 widgetDefault
option add *Radiobox.labelFont \
"-Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*" widgetDefault
option add *Radiobox.labelPos nw widgetDefault
option add *Radiobox.borderWidth 2 widgetDefault
option add *Radiobox.relief groove widgetDefault
# ------------------------------------------------------------------
# CONSTRUCTOR
# ------------------------------------------------------------------
itcl::body iwidgets::Radiobox::constructor {args} {
#
# Initialize the _modes array element prior to setting the trace. This
# prevents the -command command (if defined) from being triggered when
# the first radiobutton is added via the add method.
#
set _modes($this) {}
trace variable [itcl::scope _modes($this)] w [itcl::code $this _command]
grid columnconfigure $itk_component(childsite) 0 -weight 1
eval itk_initialize $args
}
# ------------------------------------------------------------------
# DESTRUCTOR
# ------------------------------------------------------------------
itcl::body iwidgets::Radiobox::destructor { } {
trace vdelete [itcl::scope _modes($this)] w [itcl::code $this _command]
catch {unset _modes($this)}
}
# ------------------------------------------------------------------
# OPTIONS
# ------------------------------------------------------------------
# ------------------------------------------------------------------
# OPTION: -command
#
# Specifies a command to be evaluated upon change in the radiobox
# ------------------------------------------------------------------
itcl::configbody iwidgets::Radiobox::command {}
# ------------------------------------------------------------------
# OPTION: -orient
#
# Allows the user to orient the radiobuttons either horizontally
# or vertically.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Radiobox::orient {
if {$itk_option(-orient) == "horizontal" ||
$itk_option(-orient) == "vertical"} {
_rearrange
} else {
error "Bad orientation: $itk_option(-orient). Should be\
\"horizontal\" or \"vertical\"."
}
}
# ------------------------------------------------------------------
# METHODS
# ------------------------------------------------------------------
# ------------------------------------------------------------------
# METHOD: index index
#
# Searches the radiobutton tags in the radiobox for the one with the
# requested tag, numerical index, or keyword "end". Returns the
# choices's numerical index if found, otherwise error.
# ------------------------------------------------------------------
itcl::body iwidgets::Radiobox::index {index} {
if {[llength $_buttons] > 0} {
if {[regexp {(^[0-9]+$)} $index]} {
if {$index < [llength $_buttons]} {
return $index
} else {
error "Radiobox index \"$index\" is out of range"
}
} elseif {$index == "end"} {
return [expr {[llength $_buttons] - 1}]
} else {
if {[set idx [lsearch $_buttons $index]] != -1} {
return $idx
}
error "bad Radiobox index \"$index\": must be number, end,\
or pattern"
}
} else {
error "Radiobox \"$itk_component(hull)\" has no radiobuttons"
}
}
# ------------------------------------------------------------------
# METHOD: add tag ?option value option value ...?
#
# Add a new tagged radiobutton to the radiobox at the end. The method
# takes additional options which are passed on to the radiobutton
# constructor. These include most of the typical radiobutton
# options. The tag is returned.
# ------------------------------------------------------------------
itcl::body iwidgets::Radiobox::add {tag args} {
set options {-value -variable}
foreach option $options {
if {[lsearch $args $option] != -1} {
error "Error: specifying values for radiobutton component options\
\"-value\" and\n \"-variable\" is disallowed. The Radiobox must\
use these options when\n adding radiobuttons."
}
}
itk_component add $tag {
eval radiobutton $itk_component(childsite).rb[incr _unique] \
-variable [list [itcl::scope _modes($this)]] \
-anchor w \
-justify left \
-highlightthickness 0 \
-value $tag $args
} {
usual
keep -state
ignore -highlightthickness -highlightcolor
rename -font -labelfont labelFont Font
}
lappend _buttons $tag
grid $itk_component($tag)
after idle [itcl::code $this _rearrange]
return $tag
}
# ------------------------------------------------------------------
# METHOD: insert index tag ?option value option value ...?
#
# Insert the tagged radiobutton in the radiobox just before the
# one given by index. Any additional options are passed on to the
# radiobutton constructor. These include the typical radiobutton
# options. The tag is returned.
# ------------------------------------------------------------------
itcl::body iwidgets::Radiobox::insert {index tag args} {
set options {-value -variable}
foreach option $options {
if {[lsearch $args $option] != -1} {
error "Error: specifying values for radiobutton component options\
\"-value\" and\n \"-variable\" is disallowed. The Radiobox must\
use these options when\n adding radiobuttons."
}
}
itk_component add $tag {
eval radiobutton $itk_component(childsite).rb[incr _unique] \
-variable [list [itcl::scope _modes($this)]] \
-highlightthickness 0 \
-anchor w \
-justify left \
-value $tag $args
} {
usual
ignore -highlightthickness -highlightcolor
rename -font -labelfont labelFont Font
}
set index [index $index]
set before [lindex $_buttons $index]
set _buttons [linsert $_buttons $index $tag]
grid $itk_component($tag)
after idle [itcl::code $this _rearrange]
return $tag
}
# ------------------------------------------------------------------
# METHOD: _rearrange
#
# Rearrange the buttons in the childsite frame using the grid
# geometry manager. This method was modified by Chad Smith on 3/9/00
# to take into consideration the newly added -orient config option.
# ------------------------------------------------------------------
itcl::body iwidgets::Radiobox::_rearrange {} {
if {[set count [llength $_buttons]] > 0} {
if {$itk_option(-orient) == "vertical"} {
set row 0
foreach tag $_buttons {
grid configure $itk_component($tag) -column 0 -row $row -sticky nw
grid rowconfigure $itk_component(childsite) $row -weight 0
incr row
}
grid rowconfigure $itk_component(childsite) [expr {$count-1}] \
-weight 1
} else {
set col 0
foreach tag $_buttons {
grid configure $itk_component($tag) -column $col -row 0 -sticky nw
grid columnconfigure $itk_component(childsite) $col -weight 1
incr col
}
}
}
}
# ------------------------------------------------------------------
# METHOD: component ?name? ?arg arg arg...?
#
# This method overrides the base class definition to provide some
# error checking. The user is disallowed from modifying the values
# of the -value and -variable options for individual radiobuttons.
# Addition of this method prompted by SF ticket 227923.
# ------------------------------------------------------------------
itcl::body iwidgets::Radiobox::component {{name ""} args} {
if {[lsearch $_buttons $name] != -1} {
# See if the user's trying to use the configure method. Note that
# because of globbing, as few characters as "co" are expanded to
# "config". Similarly, "configu" will expand to "configure".
if [regexp {^co+} [lindex $args 0]] {
# The user's trying to modify a radiobutton. This is all fine and
# dandy unless -value or -variable is being modified.
set options {-value -variable}
foreach option $options {
set index [lsearch $args $option]
if {$index != -1} {
# If a value is actually specified, throw an error.
if {[lindex $args [expr {$index + 1}]] != ""} {
error "Error: specifying values for radiobutton component options\
\"-value\" and\n \"-variable\" is disallowed. The Radiobox\
uses these options internally."
}
}
}
}
}
eval chain $name $args
}
# ------------------------------------------------------------------
# METHOD: delete index
#
# Delete the specified radiobutton.
# ------------------------------------------------------------------
itcl::body iwidgets::Radiobox::delete {index} {
set tag [gettag $index]
set index [index $index]
destroy $itk_component($tag)
set _buttons [lreplace $_buttons $index $index]
if {$_modes($this) == $tag} {
set _modes($this) {}
}
after idle [itcl::code $this _rearrange]
return
}
# ------------------------------------------------------------------
# METHOD: select index
#
# Select the specified radiobutton.
# ------------------------------------------------------------------
itcl::body iwidgets::Radiobox::select {index} {
set tag [gettag $index]
$itk_component($tag) invoke
}
# ------------------------------------------------------------------
# METHOD: get
#
# Return the tag of the currently selected radiobutton.
# ------------------------------------------------------------------
itcl::body iwidgets::Radiobox::get {} {
return $_modes($this)
}
# ------------------------------------------------------------------
# METHOD: deselect index
#
# Deselect the specified radiobutton.
# ------------------------------------------------------------------
itcl::body iwidgets::Radiobox::deselect {index} {
set tag [gettag $index]
$itk_component($tag) deselect
}
# ------------------------------------------------------------------
# METHOD: flash index
#
# Flash the specified radiobutton.
# ------------------------------------------------------------------
itcl::body iwidgets::Radiobox::flash {index} {
set tag [gettag $index]
$itk_component($tag) flash
}
# ------------------------------------------------------------------
# METHOD: buttonconfigure index ?option? ?value option value ...?
#
# Configure a specified radiobutton. This method allows configuration
# of radiobuttons from the Radiobox level. The options may have any
# of the values accepted by the add method.
# ------------------------------------------------------------------
itcl::body iwidgets::Radiobox::buttonconfigure {index args} {
set tag [gettag $index]
eval $itk_component($tag) configure $args
}
# ------------------------------------------------------------------
# CALLBACK METHOD: _command name1 name2 opt
#
# Tied to the trace on _modes($this). Whenever our -variable for our
# radiobuttons change, this method is invoked. It in turn calls
# the user specified tcl script given by -command.
# ------------------------------------------------------------------
itcl::body iwidgets::Radiobox::_command { name1 name2 opt } {
uplevel #0 $itk_option(-command)
}
# ------------------------------------------------------------------
# METHOD: gettag index
#
# Return the tag of the checkbutton associated with a specified
# numeric index
# ------------------------------------------------------------------
itcl::body iwidgets::Radiobox::gettag {index} {
return [lindex $_buttons [index $index]]
}