nm.tcl~

一个用TCL/TK写的用于verilog的集成编辑环境.

    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 {} {}
}


# ------------------------------------------------------------------------------
#  Command Button::create
# ------------------------------------------------------------------------------
proc Button::create { path args } {
    Widget::init Button $path $args

    set relief [Widget::getoption $path -relief]
    if { ![string compare $relief "link"] } {
        set relief "flat"
    }

    set var [Widget::getoption $path -textvariable]
    if {  ![string length $var] } {
        set desc [BWidget::getname [Widget::getoption $path -name]]
        if { [llength $desc] } {
            set text  [lindex $desc 0]
            set under [lindex $desc 1]
            Widget::setoption $path -text $text
            Widget::setoption $path -underline $under
        } else {
            set text  [Widget::getoption $path -text]
            set under [Widget::getoption $path -underline]
        }
    } else {
        set under -1
        set text  ""
        Widget::setoption $path -underline $under
    }

    eval button $path [Widget::subcget $path :cmd] \
        [list -relief $relief -text $text -underline $under -textvariable $var]
    bindtags $path [list $path BwButton [winfo toplevel $path] all]

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

    DynamicHelp::sethelp $path $path 1

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

    return $path
}


# ------------------------------------------------------------------------------
#  Command Button::configure
# ------------------------------------------------------------------------------
proc Button::configure { path args } {
    set oldunder [$path:cmd cget -underline]
    if { $oldunder != -1 } {
        set oldaccel [string tolower [string index [$path:cmd cget -text] $oldunder]]
    } else {
        set oldaccel ""
    }
    set res [Widget::configure $path $args]

    set rc [Widget::hasChanged $path -relief relief]
    set sc [Widget::hasChanged $path -state  state]

    if { $rc || $sc } {
        if { ![string compare $relief "link"] } {
            if { ![string compare $state "active"] } {
                set relief "raised"
            } else {
                set relief "flat"
            }
        }
        $path:cmd configure -relief $relief -state $state
    }

    set cv [Widget::hasChanged $path -textvariable var]
    set cn [Widget::hasChanged $path -name name]
    set ct [Widget::hasChanged $path -text text]
    set cu [Widget::hasChanged $path -underline under]

    if { $cv || $cn || $ct || $cu } {
        if {  ![string length $var] } {
            set desc [BWidget::getname $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]
        bind $top <Alt-$oldaccel> {}
        set accel [string tolower [string index $text $under]]
        if { $accel != "" } {
            bind $top <Alt-$accel> "Button::invoke $path"
        }
        $path:cmd configure -text $text -underline $under -textvariable $var
    }
    DynamicHelp::sethelp $path $path

    return $res
}


# ------------------------------------------------------------------------------
#  Command Button::cget
# ------------------------------------------------------------------------------
proc Button::cget { path option } {
    return [Widget::cget $path $option]
}


# ------------------------------------------------------------------------------
#  Command Button::invoke
# ------------------------------------------------------------------------------
proc Button::invoke { path } {
    if { [string compare [$path:cmd cget -state] "disabled"] } {
	$path:cmd configure -state active -relief sunken
	update idletasks
        if { [set cmd [Widget::getoption $path -armcommand]] != "" } {
            uplevel \#0 $cmd
        }
	after 100
        set relief [Widget::getoption $path -relief]
        if { ![string compare $relief "link"] } {
            set relief flat
        }
	$path:cmd configure \
            -state  [Widget::getoption $path -state] \
            -relief $relief
        if { [set cmd [Widget::getoption $path -disarmcommand]] != "" } {
            uplevel \#0 $cmd
        }
        if { [set cmd [Widget::getoption $path -command]] != "" } {
            uplevel \#0 $cmd
        }
    }
}


# ------------------------------------------------------------------------------
#  Command Button::_enter
# ------------------------------------------------------------------------------
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::getoption $path -relief] "link"] } {
            $path:cmd configure -relief raised
        }
    }
}


# ------------------------------------------------------------------------------
#  Command Button::_leave
# ------------------------------------------------------------------------------
proc Button::_leave { path } {
    variable _current
    variable _pressed

    set _current ""
    if { [string compare [$path:cmd cget -state] "disabled"] } {
        $path:cmd configure -state [Widget::getoption $path -state]
        set relief [Widget::getoption $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
        }
    }
}


# ------------------------------------------------------------------------------
#  Command Button::_press
# ------------------------------------------------------------------------------
proc Button::_press { path } {
    variable _pressed

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


# ------------------------------------------------------------------------------
#  Command Button::_release
# ------------------------------------------------------------------------------
proc Button::_release { path } {
    variable _current
    variable _pressed

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


# ------------------------------------------------------------------------------
#  Command Button::_repeat
# ------------------------------------------------------------------------------
proc Button::_repeat { path } {
    variable _current
    variable _pressed

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

# ------------------------------------------------------------------------------
#  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
# ------------------------------------------------------------------------------

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 {=0}}
        {-padx        TkResource ""         0 button}
        {-pady        TkResource ""         0 button}
        {-default     Int        -1         0 {=-1}} 
        {-bg          Synonym    -background}
    }

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

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


# ------------------------------------------------------------------------------
#  Command ButtonBox::create
# ------------------------------------------------------------------------------
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

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

    bind $path <Destroy> "ButtonBox::_destroy $path"

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

    return $path
}


# ------------------------------------------------------------------------------
#  Command ButtonBox::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
}


# ------------------------------------------------------------------------------
#  Command ButtonBox::cget
# ------------------------------------------------------------------------------
proc ButtonBox::cget { path option } {
    return [Widget::cget $path $option]
}


# ------------------------------------------------------------------------------
#  Command ButtonBox::add
# ------------------------------------------------------------------------------
proc ButtonBox::add { path args } {
    variable $path
    upvar 0  $path data

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