Subversion Repositories or1k

#

# Checkbox

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

# Implements a checkbuttonbox.  Supports adding, inserting, deleting,

# selecting, and deselecting of checkbuttons by tag and index.

#

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

#  AUTHOR: John A. Tucker                EMAIL: jatucker@spd.dsccc.com

#

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

#            Copyright (c) 1997 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.

# ======================================================================

#

# Use option database to override default resources of base classes.

#

option add *Checkbox.labelMargin        10      widgetDefault

option add *Checkbox.labelFont     \

      "-Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*"  widgetDefault

option add *Checkbox.labelPos           nw      widgetDefault

option add *Checkbox.borderWidth        2       widgetDefault

option add *Checkbox.relief             groove  widgetDefault

#

# Usual options.

#

itk::usual Checkbox {

    keep -background -borderwidth -cursor -disabledforeground \

        -foreground -labelfont -selectcolor

}

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

#                            CHECKBOX

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

class iwidgets::Checkbox {

    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 insert {index tag args}

      method delete {index}

      method get {{index ""}}

      method index {index}

      method select {index}

      method deselect {index}

      method flash {index}

      method toggle {index}

      method buttonconfigure {index args}

  }

  private {

      method gettag {index}      ;# Get the tag of the checkbutton associated

                                 ;# with a numeric index

      variable _unique 0         ;# Unique id for choice creation.

      variable _buttons {}       ;# List of checkbutton tags.

      common buttonVar           ;# Array of checkbutton "-variables"

  }

}

#

# Provide a lowercased access method for the Checkbox class.

#

proc ::iwidgets::checkbox {pathName args} {

    uplevel ::iwidgets::Checkbox $pathName $args

}

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

#                        CONSTRUCTOR

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

body iwidgets::Checkbox::constructor {args} {

    eval itk_initialize $args

}

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

#                            OPTIONS

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

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

# OPTION: -command

#

# Specifies a command to be evaluated upon change in the checkbox

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

configbody iwidgets::Checkbox::command {}

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

#                            METHODS

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

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

# METHOD: index index

#

# Searches the checkbutton tags in the checkbox for the one with the

# requested tag, numerical index, or keyword "end".  Returns the

# choices's numerical index if found, otherwise error.

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

body iwidgets::Checkbox::index {index} {

    if {[llength $_buttons] > 0} {

        if {[regexp {(^[0-9]+$)} $index]} {

            if {$index < [llength $_buttons]} {

                return $index

            } else {

                error "Checkbox 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 Checkbox index \"$index\": must be number, end,\

                    or pattern"

        }

    } else {

        error "Checkbox \"$itk_component(hull)\" has no checkbuttons"

    }

}

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

# METHOD: add tag ?option value option value ...?

#

# Add a new tagged checkbutton to the checkbox at the end.  The method

# takes additional options which are passed on to the checkbutton

# constructor.  These include most of the typical checkbutton

# options.  The tag is returned.

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

body iwidgets::Checkbox::add {tag args} {

    itk_component add $tag {

        eval checkbutton $itk_component(childsite).cb[incr _unique] \

            -variable [list [scope buttonVar($this,$tag)]] \

            -anchor w \

            -justify left \

            -highlightthickness 0 \

            $args

    } {

      usual

      ignore -highlightthickness -highlightcolor

      rename -font -labelfont labelFont Font

    }

    pack $itk_component($tag) -anchor w -padx 4

    lappend _buttons $tag

    return $tag

}

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

# METHOD: insert index tag ?option value option value ...?

#

# Insert the tagged checkbutton in the checkbox just before the

# one given by index.  Any additional options are passed on to the

# checkbutton constructor.  These include the typical checkbutton

# options.  The tag is returned.

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

body iwidgets::Checkbox::insert {index tag args} {

    itk_component add $tag {

        eval checkbutton $itk_component(childsite).cb[incr _unique] \

            -variable [list [scope buttonVar($this,$tag)]] \

            -anchor w \

            -justify left \

            -highlightthickness 0 \

            $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]

    pack $itk_component($tag) -anchor w -padx 4 -before $itk_component($before)

    return $tag

}

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

# METHOD: delete index

#

# Delete the specified checkbutton.

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

body iwidgets::Checkbox::delete {index} {

    set tag [gettag $index]

    set index [index $index]

    destroy $itk_component($tag)

    set _buttons [lreplace $_buttons $index $index]

    if { [info exists buttonVar($this,$tag)] == 1 } {

        unset buttonVar($this,$tag)

    }

}

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

# METHOD: select index

#

# Select the specified checkbutton.

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

body iwidgets::Checkbox::select {index} {

    set tag [gettag $index]

    $itk_component($tag) invoke

}

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

# METHOD: toggle index

#

# Toggle a specified checkbutton between selected and unselected

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

body iwidgets::Checkbox::toggle {index} {

    set tag [gettag $index]

    $itk_component($tag) toggle

}

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

# METHOD: get

#

# Return the value of the checkbutton with the given index, or a

# list of all checkbutton values in increasing order by index.

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

body iwidgets::Checkbox::get {{index ""}} {

    set result {}

    if {$index == ""} {

        foreach tag $_buttons {

            if {$buttonVar($this,$tag)} {

                lappend result $tag

            }

        }

    } else {

        set tag [gettag $index]

        set result $buttonVar($this,$tag)

    }

    return $result

}

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

# METHOD: deselect index

#

# Deselect the specified checkbutton.

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

body iwidgets::Checkbox::deselect {index} {

    set tag [gettag $index]

    $itk_component($tag) deselect

}

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

# METHOD: flash index

#

# Flash the specified checkbutton.

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

body iwidgets::Checkbox::flash {index} {

    set tag [gettag $index]

    $itk_component($tag) flash

}

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

# METHOD: buttonconfigure index ?option? ?value option value ...?

#

# Configure a specified checkbutton.  This method allows configuration

# of checkbuttons from the Checkbox level.  The options may have any

# of the values accepted by the add method.

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

body iwidgets::Checkbox::buttonconfigure {index args} {

    set tag [gettag $index]

    eval $itk_component($tag) configure $args

}

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

# METHOD: gettag index

#

# Return the tag of the checkbutton associated with a specified

# numeric index

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

body iwidgets::Checkbox::gettag {index} {

    return [lindex $_buttons [index $index]]

}