buttonbox.tcl

buttonbox.tcl
This file is part of Unifix BWidget Toolkit
Index of commands:
- ButtonBox::create
- ButtonBox::configure
- ButtonBox::cget
- ButtonBox::add
- ButtonBox::itemconfigure
- ButtonBox::itemcget
- ButtonBox::setfocus
- ButtonBox::invoke
- ButtonBox::index
- ButtonBox::_destroy


::ButtonBox::getbuttonstate
Comments ::ButtonBox::getbuttonstate --

Retrieve the state of a given button tag.

Arguments:
path the button box widget name
tag the tag to modify

Results:
None.
Arguments path
tag
Used by  
Uses  
proc ::ButtonBox::getbuttonstate {path tag} {
    variable $path
    upvar 0  $path data
    # First see if this is a real tag
    if { [info exists data(tagstate,$tag)] } {
    return $data(tagstate,$tag)
    } else {
    error "unknown tag $tag"
    }
}


::ButtonBox::gettags
Comments ::ButtonBox::gettags --

Return a list of all the tags on all the buttons in a buttonbox.

Arguments:
path the buttonbox to query.

Results:
taglist a list of tags on the buttons in the buttonbox
Arguments path
Used by  
Uses  
proc ::ButtonBox::gettags {path} {
    upvar ::ButtonBox::$path data
    set taglist {}
    foreach tag [array names data "tags,*"] {
    lappend taglist [string range $tag 5 end]
    }
    return $taglist
}


::ButtonBox::setbuttonstate
Comments ::ButtonBox::setbuttonstate --

Set the state of a given button tag. If this makes any buttons
enable-able (ie, all of their tags are TRUE), enable them.

Arguments:
path the button box widget name
tag the tag to modify
state the new state of $tag (0 or 1)

Results:
None.
Arguments path
tag
state
Used by  
Uses  
proc ::ButtonBox::setbuttonstate {path tag state} {
    variable $path
    upvar 0  $path data
    # First see if this is a real tag
    if { [info exists data(tagstate,$tag)] } {
    set data(tagstate,$tag) $state
    foreach but $data(tags,$tag) {
        set expression "1"
        foreach buttontag $data(buttontags,$but) {
        append expression " && $data(tagstate,$buttontag)"
        }
        if { [expr $expression] } {
        set state normal
        } else {
        set state disabled
        }
        $but configure -state $state
    }
    }
    return
}


ButtonBox
Comments  
Arguments  
Used by  
Uses  
namespace eval ButtonBox {
    Button::use

    Widget::declare ButtonBox {
        {-background  TkResource ""         0 frame}
        {-orient      Enum       horizontal 1 {horizontal vertical}}
        {-homogeneous Boolean    1          1}
        {-spacing     Int        10         0 "%d >= 0"}
        {-padx        TkResource ""         0 button}
        {-pady        TkResource ""         0 button}
        {-default     Int        -1         0 "%d >= -1"}
        {-bg          Synonym    -background}
    }

    Widget::addmap ButtonBox "" :cmd {-background {}}

    proc ::ButtonBox { path args } { return [eval ButtonBox::create $path $args] }
    proc use {} {}
}


ButtonBox::_destroy
Comments Command ButtonBox::_destroy
Arguments path
Used by ButtonBox::create
Uses Widget::destroy
proc ButtonBox::_destroy { path } {
    variable $path
    upvar 0  $path data

    Widget::destroy $path
    unset data
    rename $path {}
}


ButtonBox::add
Comments Command ButtonBox::add
Arguments path
args
Used by Dialog::add
Uses Widget::getoption
Button::create
proc ButtonBox::add { path args } {
    variable $path
    upvar 0  $path data

    set but     $path.b$data(nbuttons)
    set spacing [Widget::getoption $path -spacing]

    if { $data(nbuttons) == $data(default) } {
        set style active
    } elseif { $data(default) == -1 } {
        set style disabled
    } else {
        set style normal
    }

    array set flags $args
    set tags ""
    if { [info exists flags(-tags)] } {
    set tags $flags(-tags)
    unset flags(-tags)
    set args [array get flags]
    }

    eval Button::create $but \
        -background [Widget::getoption $path -background]\
        -padx       [Widget::getoption $path -padx] \
        -pady       [Widget::getoption $path -pady] \
        $args \
        -default $style

    # ericm@scriptics.com:  set up tags, just like the menu items
    foreach tag $tags {
    lappend data(tags,$tag) $but
    if { ![info exists data(tagstate,$tag)] } {
        set data(tagstate,$tag) 0
    }
    }
    set data(buttontags,$but) $tags
    # ericm@scriptics.com

    set idx [expr {2*$data(nbuttons)}]
    if { ![string compare [Widget::getoption $path -orient] "horizontal"] } {
        grid $but -column $idx -row 0 -sticky nsew
        if { [Widget::getoption $path -homogeneous] } {
            set req [winfo reqwidth $but]
            if { $req > $data(max) } {
                for {set i 0} {$i < $data(nbuttons)} {incr i} {
                    grid columnconfigure $path [expr {2*$i}] -minsize $req
                }
                set data(max) $req
            }
            grid columnconfigure $path $idx -minsize $data(max) -weight 1
        } else {
            grid columnconfigure $path $idx -weight 0
        }
        if { $data(nbuttons) > 0 } {
            grid columnconfigure $path [expr {$idx-1}] -minsize $spacing
        }
    } else {
        grid $but -column 0 -row $idx -sticky nsew
        grid rowconfigure $path $idx -weight 0
        if { $data(nbuttons) > 0 } {
            grid rowconfigure $path [expr {$idx-1}] -minsize $spacing
        }
    }

    incr data(nbuttons)

    return $but
}


ButtonBox::cget
Comments Command ButtonBox::cget
Arguments path
option
Used by  
Uses Widget::cget
proc ButtonBox::cget { path option } {
    return [Widget::cget $path $option]
}


ButtonBox::configure
Comments Command ButtonBox::configure
Arguments path
args
Used by  
Uses Widget::setoption
Widget::hasChanged
Widget::configure
proc ButtonBox::configure { path args } {
    variable $path
    upvar 0  $path data

    set res [Widget::configure $path $args]

    if { [Widget::hasChanged $path -default val] } {
        if { $data(default) != -1 && $val != -1 } {
            set but $path.b$data(default)
            if { [winfo exists $but] } {
                $but configure -default normal
            }
            set but $path.b$val
            if { [winfo exists $but] } {
                $but configure -default active
            }
            set data(default) $val
        } else {
            Widget::setoption $path -default $data(default)
        }
    }

    return $res
}


ButtonBox::create
Comments Command ButtonBox::create
Arguments path
args
Used by Dialog::create
Uses Widget::getoption
ButtonBox::_destroy
Widget::init
Widget::subcget
proc ButtonBox::create { path args } {
    Widget::init ButtonBox $path $args

    variable $path
    upvar 0  $path data

    eval frame $path [Widget::subcget $path :cmd] -takefocus 0 \
        -highlightthickness 0
    # For 8.4+ we don't want to inherit the padding
    catch {$path configure -padx 0 -pady 0}

    set data(default)  [Widget::getoption $path -default]
    set data(nbuttons) 0
    set data(max)      0

    bind $path <Destroy> [list ButtonBox::_destroy $path]

    rename $path ::$path:cmd
    proc ::$path { cmd args } \
        "return \[eval ButtonBox::\$cmd [list $path] \$args\]"

    return $path
}


ButtonBox::index
Comments Command ButtonBox::index
Arguments path
index
Used by  
Uses Widget::getoption
proc ButtonBox::index { path index } {
    if { ![string compare $index "default"] } {
        set res [Widget::getoption $path -default]
    } elseif {$index == "end" || $index == "last"} {
        variable $path
        upvar 0  $path data

        set res [expr {$data(nbuttons)-1}]
    } else {
        set res $index
    }
    return $res
}


ButtonBox::invoke
Comments Command ButtonBox::invoke
Arguments path
index
Used by Dialog::invoke
Uses Button::invoke
proc ButtonBox::invoke { path index } {
    set but $path.b[index $path $index]
    if { [winfo exists $but] } {
        Button::invoke $but
    }
}


ButtonBox::itemcget
Comments Command ButtonBox::itemcget
Arguments path
index
option
Used by Dialog::itemcget
Uses Button::cget
proc ButtonBox::itemcget { path index option } {
    return [Button::cget $path.b[index $path $index] $option]
}


ButtonBox::itemconfigure
Comments Command ButtonBox::itemconfigure
Arguments path
index
args
Used by Dialog::itemconfigure
Uses Button::configure
proc ButtonBox::itemconfigure { path index args } {
    if { [set idx [lsearch $args -default]] != -1 } {
        set args [lreplace $args $idx [expr {$idx+1}]]
    }
    return [eval Button::configure $path.b[index $path $index] $args]
}


ButtonBox::setfocus
Comments Command ButtonBox::setfocus
Arguments path
index
Used by Dialog::draw
Dialog::setfocus
Uses  
proc ButtonBox::setfocus { path index } {
    set but $path.b[index $path $index]
    if { [winfo exists $but] } {
        focus $but
    }
}
generated by zdoc.tcl on 2003-03-06 00:21:53