button.tcl

button.tcl
This file is part of Unifix BWidget Toolkit
Index of commands:
Public commands
- Button::create
- Button::configure
- Button::cget
- Button::invoke
Private commands (event bindings)
- Button::_destroy
- Button::_enter
- Button::_leave
- Button::_press
- Button::_release
- Button::_repeat


Button
Comments  
Arguments  
Used by  
Uses  
namespace eval Button {
    set remove [list -command -relief -text -textvariable -underline -state]
    if {[info tclversion] > 8.3} {
    lappend remove -repeatdelay -repeatinterval
    }
    Widget::tkinclude Button button :cmd remove $remove

    Widget::declare Button {
        {-name            String "" 0}
        {-text            String "" 0}
        {-textvariable    String "" 0}
        {-underline       Int    -1 0 "%d >= -1"}
        {-armcommand      String "" 0}
        {-disarmcommand   String "" 0}
        {-command         String "" 0}
        {-state           TkResource "" 0 button}
        {-repeatdelay     Int    0  0 "%d >= 0"}
        {-repeatinterval  Int    0  0 "%d >= 0"}
        {-relief          Enum   raised  0 {raised sunken flat ridge solid groove link}}
    }

    DynamicHelp::include Button balloon

    Widget::syncoptions Button "" :cmd {-text {} -underline {}}

    variable _current ""
    variable _pressed ""

    bind BwButton <Enter>           {Button::_enter %W}
    bind BwButton <Leave>           {Button::_leave %W}
    bind BwButton <ButtonPress-1>   {Button::_press %W}
    bind BwButton <ButtonRelease-1> {Button::_release %W}
    bind BwButton <Key-space>       {Button::invoke %W; break}
    bind BwButton <Return>          {Button::invoke %W; break}
    bind BwButton <Destroy>         {Widget::destroy %W; rename %W {}}

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


Button::_enter
Comments Command Button::_enter
Arguments path
Used by  
Uses Widget::cget
proc Button::_enter { path } {
    variable _current
    variable _pressed

    set _current $path
    if { [string compare [$path:cmd cget -state] "disabled"] } {
        $path:cmd configure -state active
        if { $_pressed == $path } {
            $path:cmd configure -relief sunken
        } elseif { ![string compare [Widget::cget $path -relief] "link"] } {
            $path:cmd configure -relief raised
        }
    }
}


Button::_leave
Comments Command Button::_leave
Arguments path
Used by  
Uses Widget::cget
proc Button::_leave { path } {
    variable _current
    variable _pressed

    set _current ""
    if { [string compare [$path:cmd cget -state] "disabled"] } {
        $path:cmd configure -state [Widget::cget $path -state]
        set relief [Widget::cget $path -relief]
        if { $_pressed == $path } {
            if { ![string compare $relief "link"] } {
                set relief raised
            }
            $path:cmd configure -relief $relief
        } elseif { ![string compare $relief "link"] } {
            $path:cmd configure -relief flat
        }
    }
}


Button::_press
Comments Command Button::_press
Arguments path
Used by  
Uses Widget::getMegawidgetOption
proc Button::_press { path } {
    variable _pressed

    if { [string compare [$path:cmd cget -state] "disabled"] } {
        set _pressed $path
    $path:cmd configure -relief sunken
    set cmd [Widget::getMegawidgetOption $path -armcommand]
        if { $cmd != "" } {
            uplevel \#0 $cmd
        set repeatdelay [Widget::getMegawidgetOption $path -repeatdelay]
        set repeatint [Widget::getMegawidgetOption $path -repeatinterval]
            if { $repeatdelay > 0 } {
                after $repeatdelay "Button::_repeat $path"
            } elseif { $repeatint > 0 } {
                after $repeatint "Button::_repeat $path"
        }
        }
    }
}


Button::_release
Comments Command Button::_release
Arguments path
Used by  
Uses Widget::getMegawidgetOption
proc Button::_release { path } {
    variable _current
    variable _pressed

    if { $_pressed == $path } {
        set _pressed ""
        set relief [Widget::getMegawidgetOption $path -relief]
        if { ![string compare $relief "link"] } {
            set relief raised
        }
        $path:cmd configure -relief $relief
    set cmd [Widget::getMegawidgetOption $path -disarmcommand]
        if { $cmd != "" } {
            uplevel \#0 $cmd
        }
        if { $_current == $path &&
             [string compare [$path:cmd cget -state] "disabled"] && \
         [set cmd [Widget::getMegawidgetOption $path -command]] != "" } {
            uplevel \#0 $cmd
        }
    }
}


Button::_repeat
Comments Command Button::_repeat
Arguments path
Used by  
Uses Widget::getMegawidgetOption
proc Button::_repeat { path } {
    variable _current
    variable _pressed

    if { $_current == $path && $_pressed == $path &&
         [string compare [$path:cmd cget -state] "disabled"] &&
         [set cmd [Widget::getMegawidgetOption $path -armcommand]] != "" } {
        uplevel \#0 $cmd
    }
    if { $_pressed == $path &&
         ([set delay [Widget::getMegawidgetOption $path -repeatinterval]] >0 ||
          [set delay [Widget::getMegawidgetOption $path -repeatdelay]] > 0) } {
        after $delay "Button::_repeat $path"
    }
}


Button::cget
Comments Command Button::cget
Arguments path
option
Used by ButtonBox::itemcget
Uses Widget::cget
proc Button::cget { path option } {
    Widget::cget $path $option
}


Button::configure
Comments Command Button::configure
Arguments path
args
Used by ButtonBox::itemconfigure
Uses BWidget::getname
Widget::cget
Widget::hasChangedX
DynamicHelp::sethelp
Widget::configure
proc Button::configure { path args } {
    set oldunder [$path:cmd cget -underline]
    if { $oldunder != -1 } {
        set oldaccel1 [string tolower [string index [$path:cmd cget -text] $oldunder]]
        set oldaccel2 [string toupper $oldaccel1]
    } else {
        set oldaccel1 ""
        set oldaccel2 ""
    }
    set res [Widget::configure $path $args]

    # Extract all the modified bits we're interested in
    foreach {cr cs cv cn ct cu} [Widget::hasChangedX $path \
        -relief -state -textvariable -name -text -underline] break
    if { $cr || $cs } {
    set relief [Widget::cget $path -relief]
    set state  [Widget::cget $path -state]
        if { ![string compare $relief "link"] } {
            if { ![string compare $state "active"] } {
                set relief "raised"
            } else {
                set relief "flat"
            }
        }
        $path:cmd configure -relief $relief -state $state
    }

    if { $cv || $cn || $ct || $cu } {
    set var        [Widget::cget $path -textvariable]
    set text    [Widget::cget $path -text]
    set under    [Widget::cget $path -underline]
        if {  ![string length $var] } {
            set desc [BWidget::getname [Widget::cget $path -name]]
            if { [llength $desc] } {
                set text  [lindex $desc 0]
                set under [lindex $desc 1]
            }
        } else {
            set under -1
            set text  ""
        }
        set top [winfo toplevel $path]
        if { $oldaccel1 != "" } {
            bind $top <Alt-$oldaccel1> {}
            bind $top <Alt-$oldaccel2> {}
        }
        set accel1 [string tolower [string index $text $under]]
        set accel2 [string toupper $accel1]
        if { $accel1 != "" } {
            bind $top <Alt-$accel1> "Button::invoke $path"
            bind $top <Alt-$accel2> "Button::invoke $path"
        }
        $path:cmd configure -text $text -underline $under -textvariable $var
    }
    DynamicHelp::sethelp $path $path

    set res
}


Button::create
Comments Command Button::create
Arguments path
args
Used by ButtonBox::add
Uses Widget::configure
Widget::parseArgs
Widget::initFromODB
DynamicHelp::sethelp
BWidget::getname
Widget::getMegawidgetOption
proc Button::create { path args } {
    array set maps [list Button {} :cmd {}]
    array set maps [Widget::parseArgs Button $args]
    eval [concat [list button $path] $maps(:cmd)]
    Widget::initFromODB Button $path $maps(Button)

    # Do some extra configuration on the button
    set relief [Widget::getMegawidgetOption $path -relief]
    if { ![string compare $relief "link"] } {
        set relief "flat"
    }
    set var [Widget::getMegawidgetOption $path -textvariable]
    set st [Widget::getMegawidgetOption $path -state]
    if {  ![string length $var] } {
        set desc [BWidget::getname [Widget::getMegawidgetOption $path -name]]
        if { [llength $desc] } {
            set text  [lindex $desc 0]
            set under [lindex $desc 1]
            Widget::configure $path [list -text $text]
            Widget::configure $path [list -underline $under]
        } else {
            set text  [Widget::getMegawidgetOption $path -text]
            set under [Widget::getMegawidgetOption $path -underline]
        }
    } else {
        set under -1
        set text  ""
        Widget::configure $path [list -underline $under]
    }

    $path configure -relief $relief -text $text -underline $under \
        -textvariable $var -state $st
    bindtags $path [list $path BwButton [winfo toplevel $path] all]

    set accel1 [string tolower [string index $text $under]]
    set accel2 [string toupper $accel1]
    if { $accel1 != "" } {
        bind [winfo toplevel $path] <Alt-$accel1> "Button::invoke $path"
        bind [winfo toplevel $path] <Alt-$accel2> "Button::invoke $path"    
    }

    DynamicHelp::sethelp $path $path 1

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

    return $path
}


Button::invoke
Comments Command Button::invoke
Arguments path
Used by ButtonBox::invoke
Uses Widget::getMegawidgetOption
proc Button::invoke { path } {
    if { [string compare [$path:cmd cget -state] "disabled"] } {
    $path:cmd configure -state active -relief sunken
    update idletasks
    set cmd [Widget::getMegawidgetOption $path -armcommand]
        if { $cmd != "" } {
            uplevel \#0 $cmd
        }
    after 100
        set relief [Widget::getMegawidgetOption $path -relief]
        if { ![string compare $relief "link"] } {
            set relief flat
        }
    $path:cmd configure \
            -state  [Widget::getMegawidgetOption $path -state] \
            -relief $relief
    set cmd [Widget::getMegawidgetOption $path -disarmcommand]
        if { $cmd != "" } {
            uplevel \#0 $cmd
        }
    set cmd [Widget::getMegawidgetOption $path -command]
        if { $cmd != "" } {
            uplevel \#0 $cmd
        }
    }
}
generated by zdoc.tcl on 2003-03-06 00:21:53