notebook.tcl

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

# ------------------------------------------------------------------------------
#  notebook.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: notebook.tcl,v 1.7 1999/07/09 11:49:18 eric Exp $
# ------------------------------------------------------------------------------
#  Index of commands:
#     - NoteBook::create
#     - NoteBook::configure
#     - NoteBook::cget
#     - NoteBook::compute_size
#     - NoteBook::insert
#     - NoteBook::delete
#     - NoteBook::itemconfigure
#     - NoteBook::itemcget
#     - NoteBook::bindtabs
#     - NoteBook::raise
#     - NoteBook::see
#     - NoteBook::page
#     - NoteBook::pages
#     - NoteBook::index
#     - NoteBook::getframe
#     - NoteBook::_test_page
#     - NoteBook::_itemconfigure
#     - NoteBook::_compute_width
#     - NoteBook::_get_x_page
#     - NoteBook::_xview
#     - NoteBook::_highlight
#     - NoteBook::_select
#     - NoteBook::_redraw
#     - NoteBook::_draw_page
#     - NoteBook::_draw_arrows
#     - NoteBook::_draw_area
#     - NoteBook::_resize
#     - NoteBook::_realize
# ------------------------------------------------------------------------------

namespace eval NoteBook {
    ArrowButton::use

    namespace eval Page {
        Widget::declare NoteBook::Page {
            {-state      Enum       normal 0 {normal disabled}}
            {-createcmd  String     ""     0}
            {-raisecmd   String     ""     0}
            {-leavecmd   String     ""     0}
            {-image      TkResource ""     0 label}
            {-text       String     ""     0}
        }
    }

    Widget::declare NoteBook {
        {-foreground         TkResource "" 0 button}
        {-background         TkResource "" 0 button}
        {-activebackground   TkResource "" 0 button}
        {-activeforeground   TkResource "" 0 button}
        {-disabledforeground TkResource "" 0 button}
        {-font               TkResource "" 0 button}
        {-side               Enum       top 1 {top bottom}}
        {-homogeneous        Boolean 0   0}
        {-borderwidth        Int 1   0 {=1 =2}}
        {-width              Int 0   0 {=0 ""}}
        {-height             Int 0   0 {=0 ""}}

        {-repeatdelay        BwResource ""  0 ArrowButton}
        {-repeatinterval     BwResource ""  0 ArrowButton}

        {-fg                 Synonym -foreground}
        {-bg                 Synonym -background}
        {-bd                 Synonym -borderwidth}
    }

    Widget::addmap NoteBook "" :cmd {-background {}}
    Widget::addmap NoteBook ArrowButton .fg \
        {-foreground {} -background {} -activeforeground {} -activebackground {} \
             -borderwidth {} -repeatinterval {} -repeatdelay {} -disabledforeground {}}
    Widget::addmap NoteBook ArrowButton .fd \
        {-foreground {} -background {} -activeforeground {} -activebackground {} \
             -borderwidth {} -repeatinterval {} -repeatdelay {} -disabledforeground {}}

    variable _warrow 12

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


# ------------------------------------------------------------------------------
#  Command NoteBook::create
# ------------------------------------------------------------------------------
proc NoteBook::create { path args } {
    variable $path
    upvar 0  $path data

    Widget::init NoteBook $path $args

    set data(base)     0
    set data(select)   ""
    set data(pages)    {}
    set data(pages)    {}
    set data(cpt)      0
    set data(realized) 0
    set data(wpage)    0
    set data(hpage)    [expr {[font metrics [Widget::getoption $path -font] -linespace] + 6}]
    set bg             [Widget::getoption $path -background]

    # --- creation du canvas -----------------------------------------------------------------
    set w [expr {[Widget::getoption $path -width]+4}]
    set h [expr {[Widget::getoption $path -height]+$data(hpage)+4}]
    canvas $path -relief flat -bd 0 -highlightthickness 0 -bg $bg -width $w -height $h

    # --- creation des arrow -----------------------------------------------------------------
    eval ArrowButton::create $path.fg [Widget::subcget $path .fg] \
        -highlightthickness 0 \
        -type button  -dir left \
        -armcommand [list "NoteBook::_xview $path -1"]

    eval ArrowButton::create $path.fd [Widget::subcget $path .fd] \
        -highlightthickness 0 \
        -type button  -dir right \
        -armcommand [list "NoteBook::_xview $path 1"]

    set col       [BWidget::get3dcolor $path $bg]
    set data(dbg) [lindex $col 0]
    set data(lbg) [lindex $col 1]

    bind $path <Configure> "NoteBook::_realize $path"
    bind $path <Destroy>   "NoteBook::_destroy $path"

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

    return $path
}


# ------------------------------------------------------------------------------
#  Command NoteBook::configure
# ------------------------------------------------------------------------------
proc NoteBook::configure { path args } {
    variable $path
    upvar 0  $path data

    set res [Widget::configure $path $args]
    set redraw 0
    if { [set chf [Widget::hasChanged $path -font font]] ||
         [Widget::hasChanged $path -homogeneous foo] } {
        if { $chf } {
            set data(hpage) [expr {[font metrics $font -linespace] + 6}]
        }
        _compute_width $path
        set redraw 1
    }
    if { [Widget::hasChanged $path -background bg] } {
        set col [BWidget::get3dcolor $path $bg]
        set data(dbg)  [lindex $col 0]
        set data(lbg)  [lindex $col 1]
        set redraw 1
    }
    if { [Widget::hasChanged $path -foreground  fg] ||
         [Widget::hasChanged $path -borderwidth bd] } {
        set redraw 1
    }
    set wc [Widget::hasChanged $path -width  w]
    set hc [Widget::hasChanged $path -height h]
    if { $wc || $hc } {
        $path:cmd configure -width [expr {$w+4}] -height [expr {$h + $data(hpage)+4}]
    } elseif { $redraw } {
        _redraw $path
    }

    return $res
}


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


# ------------------------------------------------------------------------------
#  Command NoteBook::compute_size
# ------------------------------------------------------------------------------
proc NoteBook::compute_size { path } {
    variable $path
    upvar 0  $path data

    set wmax 0
    set hmax 0
    update idletasks
    foreach page $data(pages) {
        set w    [winfo reqwidth  $path.f$page]
        set h    [winfo reqheight $path.f$page]
        set wmax [expr {$w>$wmax ? $w : $wmax}]
        set hmax [expr {$h>$hmax ? $h : $hmax}]
    }
    configure $path -width $wmax -height $hmax
}


# ------------------------------------------------------------------------------
#  Command NoteBook::insert
# ------------------------------------------------------------------------------
proc NoteBook::insert { path index page args } {
    variable $path
    upvar 0  $path data

    if { [lsearch $data(pages) $page] != -1 } {
        return -code error "page \"$page\" already exists"
    }

    Widget::init NoteBook::Page $path.f$page $args

    set data(pages) [linsert $data(pages) $index $page]
    if { ![winfo exists $path.f$page] } {
        frame $path.f$page \
            -relief flat -background [Widget::getoption $path -background] -borderwidth 10
        set data($page,realized) 0
    }
    _compute_width $path
    _draw_page $path $page 1
    _redraw $path

    return $path.f$page
}


# ------------------------------------------------------------------------------
#  Command NoteBook::delete
# ------------------------------------------------------------------------------
proc NoteBook::delete { path page {destroyframe 1} } {
    variable $path
    upvar 0  $path data

    set pos [_test_page $path $page]
    set data(pages) [lreplace $data(pages) $pos $pos]
    _compute_width $path
    $path:cmd delete p:$page
    if { $data(select) == $page } {
        set data(select) ""
    }
    if { $pos < $data(base) } {
        incr data(base) -1
    }
    if { $destroyframe } {
        destroy $path.f$page
    }
    _redraw $path
}


# ------------------------------------------------------------------------------
#  Command NoteBook::itemconfigure
# ------------------------------------------------------------------------------
proc NoteBook::itemconfigure { path page args } {
    _test_page $path $page
    set res [_itemconfigure $path $page $args]
    _redraw $path

    return $res
}


# ------------------------------------------------------------------------------
#  Command NoteBook::itemcget
# ------------------------------------------------------------------------------
proc NoteBook::itemcget { path page option } {
    _test_page $path $page
    return [Widget::cget $path.f$page $option]
}


# ------------------------------------------------------------------------------
#  Command NoteBook::bindtabs
# ------------------------------------------------------------------------------
proc NoteBook::bindtabs { path event script } {
    if { $script != "" } {
        $path:cmd bind "page" $event \
            "$script \[string range \[lindex \[$path:cmd gettags current\] 1\] 2 end\]"
    } else {
        $path:cmd bind "page" $event {}
    }
}


# ------------------------------------------------------------------------------
#  Command NoteBook::move
# ------------------------------------------------------------------------------
proc NoteBook::move { path page index } {
    variable $path
    upvar 0  $path data

    set pos [_test_page $path $page]
    set data(pages) [linsert [lreplace $data(pages) $pos $pos] $index $page]
    _redraw $path
}


# ------------------------------------------------------------------------------
#  Command NoteBook::raise
# ------------------------------------------------------------------------------
proc NoteBook::raise { path {page ""} } {
    variable $path
    upvar 0  $path data

    if { $page != "" } {
        _test_page $path $page
        _select $path $page
    }
    return $data(select)
}


# ------------------------------------------------------------------------------
#  Command NoteBook::see
# ------------------------------------------------------------------------------
proc NoteBook::see { path page } {
    variable $path
    upvar 0  $path data

    set pos [_test_page $path $page]
    if { $pos < $data(base) } {
        set data(base) $pos
        _redraw $path
    } else {
        set w     [expr {[winfo width $path]-1}]
        set fpage [expr {[_get_x_page $path $pos] + $data($page,width) + 6}]
        set idx   $data(base)
        while { $idx < $pos && $fpage > $w } {
            set fpage [expr {$fpage - $data([lindex $data(pages) $idx],width)}]
            incr idx
        }
        if { $idx != $data(base) } {
            set data(base) $idx
            _redraw $path
        }
    }
}


# ------------------------------------------------------------------------------
#  Command NoteBook::page
# ------------------------------------------------------------------------------
proc NoteBook::page { path first {last ""} } {
    variable $path
    upvar 0  $path data

    if { $last == "" } {
        return [lindex $data(pages) $first]
    } else {
        return [lrange $data(pages) $first $last]
    }
}


# ------------------------------------------------------------------------------
#  Command NoteBook::pages
# ------------------------------------------------------------------------------
proc NoteBook::pages { path {first ""} {last ""}} {
    variable $path
    upvar 0  $path data

    if { ![string length $first] } {
	return $data(pages)
    }

    if { ![string length $last] } {
        return [lindex $data(pages) $first]
    } else {
        return [lrange $data(pages) $first $last]
    }
}


# ------------------------------------------------------------------------------
#  Command NoteBook::index
# ------------------------------------------------------------------------------
proc NoteBook::index { path page } {
    variable $path
    upvar 0  $path data

    return [lsearch $data(pages) $page]
}


# ------------------------------------------------------------------------------
#  Command NoteBook::_destroy
# ------------------------------------------------------------------------------
proc NoteBook::_destroy { path } {
    variable $path
    upvar 0  $path data

    foreach page $data(pages) {
        Widget::destroy $path.f$page
    }
    Widget::destroy $path
    unset data
    rename $path {}
}


# ------------------------------------------------------------------------------
#  Command NoteBook::getframe
# ------------------------------------------------------------------------------
proc NoteBook::getframe { path page } {
    return $path.f$page
}


# ------------------------------------------------------------------------------
#  Command NoteBook::_test_page
# ------------------------------------------------------------------------------
proc NoteBook::_test_page { path page } {
    variable $path
    upvar 0  $path data

    if { [set pos [lsearch $data(pages) $page]] == -1 } {
        return -code error "page \"$page\" does not exists"
    }
    return $pos
}


# ------------------------------------------------------------------------------
#  Command NoteBook::_itemconfigure
# ------------------------------------------------------------------------------
proc NoteBook::_itemconfigure { path page lres } {
    variable $path
    upvar 0  $path data

    set res [Widget::configure $path.f$page $lres]
    if { [Widget::hasChanged $path.f$page -text foo] } {