URL
https://opencores.org/ocsvn/or1k/or1k/trunk
Subversion Repositories or1k
[/] [or1k/] [tags/] [start/] [insight/] [itcl/] [iwidgets3.0.0/] [generic/] [radiobox.itk] - Rev 578
Go to most recent revision | Compare with Previous | Blame | View Log
#
# 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.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.
# ======================================================================
#
# Usual options.
#
itk::usual Radiobox {
keep -background -borderwidth -cursor -disabledforeground \
-foreground -labelfont -selectcolor
}
# ------------------------------------------------------------------
# RADIOBOX
# ------------------------------------------------------------------
class iwidgets::Radiobox {
inherit iwidgets::Labeledframe
constructor {args} {}
itk_option define -disabledforeground \
disabledForeground DisabledForeground {}
itk_option define -selectcolor selectColor Background {}
itk_option define -command command Command {}
public {
method add {tag args}
method buttonconfigure {index 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
# ------------------------------------------------------------------
body iwidgets::Radiobox::constructor {args} {
trace variable [scope _modes($this)] w [code $this _command]
grid columnconfigure $itk_component(childsite) 0 -weight 1
eval itk_initialize $args
}
# ------------------------------------------------------------------
# OPTIONS
# ------------------------------------------------------------------
# ------------------------------------------------------------------
# OPTION: -command
#
# Specifies a command to be evaluated upon change in the radiobox
# ------------------------------------------------------------------
configbody iwidgets::Radiobox::command {}
# ------------------------------------------------------------------
# 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.
# ------------------------------------------------------------------
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.
# ------------------------------------------------------------------
body iwidgets::Radiobox::add {tag args} {
itk_component add $tag {
eval radiobutton $itk_component(childsite).rb[incr _unique] \
-variable [list [scope _modes($this)]] \
-anchor w \
-justify left \
-highlightthickness 0 \
-value $tag $args
} {
usual
ignore -highlightthickness -highlightcolor
rename -font -labelfont labelFont Font
}
lappend _buttons $tag
grid $itk_component($tag)
after idle [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.
# ------------------------------------------------------------------
body iwidgets::Radiobox::insert {index tag args} {
itk_component add $tag {
eval radiobutton $itk_component(childsite).rb[incr _unique] \
-variable [list [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 [code $this _rearrange]
return $tag
}
# ------------------------------------------------------------------
# METHOD: _rearrange
#
# Rearrange the buttons in the childsite frame using
# the grid geometry manager.
# ------------------------------------------------------------------
body iwidgets::Radiobox::_rearrange {} {
set index 0
set master $itk_component(childsite)
if {[set count [llength $_buttons]] > 0} {
foreach tag $_buttons {
grid configure $itk_component($tag) -row $index -sticky nw
grid rowconfigure $master $index -weight 0
incr index
}
grid rowconfigure $master [expr $count-1] -weight 1
}
}
# ------------------------------------------------------------------
# METHOD: delete index
#
# Delete the specified radiobutton.
# ------------------------------------------------------------------
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 [code $this _rearrange]
return
}
# ------------------------------------------------------------------
# METHOD: select index
#
# Select the specified radiobutton.
# ------------------------------------------------------------------
body iwidgets::Radiobox::select {index} {
set tag [gettag $index]
$itk_component($tag) invoke
}
# ------------------------------------------------------------------
# METHOD: get
#
# Return the tag of the currently selected radiobutton.
# ------------------------------------------------------------------
body iwidgets::Radiobox::get {} {
return $_modes($this)
}
# ------------------------------------------------------------------
# METHOD: deselect index
#
# Deselect the specified radiobutton.
# ------------------------------------------------------------------
body iwidgets::Radiobox::deselect {index} {
set tag [gettag $index]
$itk_component($tag) deselect
}
# ------------------------------------------------------------------
# METHOD: flash index
#
# Flash the specified radiobutton.
# ------------------------------------------------------------------
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.
# ------------------------------------------------------------------
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.
# ------------------------------------------------------------------
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
# ------------------------------------------------------------------
body iwidgets::Radiobox::gettag {index} {
return [lindex $_buttons [index $index]]
}
Go to most recent revision | Compare with Previous | Blame | View Log