notebook.tcl

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

        _compute_width $path
    } elseif  { [Widget::hasChanged $path.f$page -image foo] } {
        set data(hpage) [expr {[font metrics [Widget::getoption $path -font] -linespace] + 6}]
        _compute_width $path
    }
    if { [Widget::hasChanged $path.f$page -state state] &&
         $state == "disabled" && $data(select) == $page } {
        set data(select) ""
    }
    return $res
}


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

    set font [Widget::getoption $path -font]
    set wmax 0
    set hmax $data(hpage)
    set wtot 0
    if { ![info exists data(textid)] } {
        set data(textid) [$path:cmd create text 0 -100 -font [Widget::getoption $path -font] -anchor nw]
    }
    set id $data(textid)
    $path:cmd itemconfigure $id -font [Widget::getoption $path -font]
    foreach page $data(pages) {
        $path:cmd itemconfigure $id -text [Widget::getoption $path.f$page -text]
        set  wtext [expr {[lindex [$path:cmd bbox $id] 2]+20}]
        if { [set img [Widget::getoption $path.f$page -image]] != "" } {
            set wtext [expr {$wtext+[image width $img]+4}]
            set himg  [expr {[image height $img]+6}]
            if { $himg > $hmax } {
                set hmax $himg
            }
        }
        set  wmax  [expr {$wtext>$wmax ? $wtext : $wmax}]
        incr wtot  $wtext
        set  data($page,width) $wtext
    }
    if { [Widget::getoption $path -homogeneous] } {
        foreach page $data(pages) {
            set data($page,width) $wmax
        }
        set wtot [expr {$wmax * [llength $data(pages)]}]
    }
    set data(hpage) $hmax
    set data(wpage) $wtot
}


# ------------------------------------------------------------------------------
#  Command NoteBook::_get_x_page
# ------------------------------------------------------------------------------
proc NoteBook::_get_x_page { path pos } {
    variable _warrow
    variable $path
    upvar 0  $path data

    set base $data(base)
    set x    [expr {$_warrow+1}]
    if { $pos < $base } {
        foreach page [lrange $data(pages) $pos [expr {$base-1}]] {
            incr x [expr {-$data($page,width)}]
        }
    } elseif { $pos > $base } {
        foreach page [lrange $data(pages) $base [expr {$pos-1}]] {
            incr x $data($page,width)
        }
    }
    return $x
}


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

    if { $inc == -1 } {
        set base [expr {$data(base)-1}]
        set dx $data([lindex $data(pages) $base],width)
    } else {
        set dx [expr {-$data([lindex $data(pages) $data(base)],width)}]
        set base [expr {$data(base)+1}]
    }

    if { $base >= 0 && $base < [llength $data(pages)] } {
        set data(base) $base
        $path:cmd move page $dx 0
        _draw_area   $path
        _draw_arrows $path
    }
}


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

    if { ![string compare [Widget::getoption $path.f$page -state] "disabled"] } {
        return
    }

    switch -- $type {
        on {
            $path:cmd itemconfigure "$page:poly" -fill [Widget::getoption $path -activebackground]
            $path:cmd itemconfigure "$page:text" -fill [Widget::getoption $path -activeforeground]
        }
        off {
            $path:cmd itemconfigure "$page:poly" -fill [Widget::getoption $path -background]
            $path:cmd itemconfigure "$page:text" -fill [Widget::getoption $path -foreground]
        }
    }
}


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

    if { ![string compare [Widget::getoption $path.f$page -state] "normal"] } {
        set oldsel $data(select)
        if { [string compare $page $oldsel] } {
            if { $oldsel != "" } {
                if { [set cmd [Widget::getoption $path.f$oldsel -leavecmd]] != "" } {
                    if { [set code [catch {uplevel \#0 $cmd} res]] == 1 || $res == 0 } {
                        return -code $code $res
                    }
                }
                set data(select) ""
                _draw_page $path $oldsel 0
            }
            set data(select) $page
            if { $page != "" } {
                if { !$data($page,realized) } {
                    set data($page,realized) 1
                    if { [set cmd [Widget::getoption $path.f$page -createcmd]] != "" } {
                        uplevel \#0 $cmd
                    }
                }
                if { [set cmd [Widget::getoption $path.f$page -raisecmd]] != "" } {
                    uplevel \#0 $cmd
                }
                _draw_page $path $page 0
            }
            _draw_area $path
        }
    }
}


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

    if { !$data(realized) } {
        return
    }

    foreach page $data(pages) {
        _draw_page $path $page 0
    }
    _draw_area   $path
    _draw_arrows $path
}


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

    # --- calcul des coordonnees et des couleurs de l'onglet ---------------------------------
    set pos [lsearch $data(pages) $page]
    set bg  [Widget::getoption $path -background]
    set h   $data(hpage)
    set xd  [_get_x_page $path $pos]
    set xf  [expr {$xd + $data($page,width)}]
    set lt  [list $xd $h $xd 4 [expr {$xd+3}] 1 $xf 1]
    set lb  [list $xf 1 [expr {$xf+3}] 4 [expr {$xf+3}] [expr {$h-3}] [expr {$xf+6}] $h]
    set img [Widget::getoption $path.f$page -image]
    if { $data(select) == $page } {
        set fgt   $data(lbg)
        set fgb   $data(dbg)
        set ytext [expr {$h/2-1}]
        if { $img == "" } {
            set xtext [expr {$xd+9}]
        } else {
            set ximg  [expr {$xd+9}]
            set xtext [expr {$ximg+[image width $img]+4}]
        }
        set bd    [Widget::getoption $path -borderwidth]
        set fg    [Widget::getoption $path -foreground]
    } else {
        set fgt   $data(dbg)
        set fgb   $fgt
        set ytext [expr {$h/2}]
        if { $img == "" } {
            set xtext [expr {$xd+10}]
        } else {
            set ximg  [expr {$xd+10}]
            set xtext [expr {$ximg+[image width $img]+4}]
        }
        set bd    1
        if { [Widget::getoption $path.f$page -state] == "normal" } {
            set fg [Widget::getoption $path -foreground]
        } else {
            set fg [Widget::getoption $path -disabledforeground]
        }
    }

    # --- creation ou modification de l'onglet -----------------------------------------------
    if { $create } {
        eval $path:cmd create polygon [concat $lt $lb] \
            -tag     {"page p:$page $page:poly"} \
            -outline $bg \
            -fill    $bg
        eval $path:cmd create line $lt -tags {"page p:$page $page:top top"} -fill $fgt -width $bd
        eval $path:cmd create line $lb -tags {"page p:$page $page:bot bot"} -fill $fgb -width $bd
        $path:cmd create text $xtext $ytext           \
            -text   [Widget::getoption $path.f$page -text] \
            -font   [Widget::getoption $path -font]        \
            -fill   $fg                               \
            -anchor w                                 \
            -tags   "page p:$page $page:text"

        $path:cmd bind p:$page <ButtonPress-1> "NoteBook::_select $path $page"
        $path:cmd bind p:$page <Enter>         "NoteBook::_highlight on  $path $page"
        $path:cmd bind p:$page <Leave>         "NoteBook::_highlight off $path $page"
    } else {
        eval $path:cmd coords "$page:poly" [concat $lt $lb]
        eval $path:cmd coords "$page:top"  $lt
        eval $path:cmd coords "$page:bot"  $lb
        $path:cmd coords "$page:text" $xtext $ytext

        $path:cmd itemconfigure "$page:poly" -fill $bg  -outline $bg
        $path:cmd itemconfigure "$page:top"  -fill $fgt -width $bd
        $path:cmd itemconfigure "$page:bot"  -fill $fgb -width $bd
        $path:cmd itemconfigure "$page:text"    \
            -text [Widget::getoption $path.f$page -text]     \
            -font [Widget::getoption $path -font]    \
            -fill $fg
    }
    if { $img != "" } {
        if { [set id [$path:cmd find withtag $page:img]] == "" } {
            $path:cmd create image $ximg $ytext \
                -image  $img \
                -anchor w    \
                -tags   "page p:$page $page:img"
        } else {
            $path:cmd coords $id $ximg $ytext
            $path:cmd itemconfigure $id -image $img
        }
    } else {
        $path:cmd delete $page:img
    }

    if { $data(select) == $page } {
        $path:cmd raise p:$page
    } elseif { $pos == 0 } {
        if { $data(select) == "" } {
            $path:cmd raise p:$page
        } else {
            $path:cmd lower p:$page p:$data(select)
        }
    } else {
        set pred [lindex $data(pages) [expr {$pos-1}]]
        if { $data(select) != $pred || $pos == 1 } {
            $path:cmd lower p:$page p:$pred
        } else {
            $path:cmd lower p:$page p:[lindex $data(pages) [expr {$pos-2}]]
        }
    }
}


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

    set w       [expr {[winfo width $path]-1}]
    set h       [expr {$data(hpage)-1}]
    set nbpages [llength $data(pages)]
    set xl      0
    set xr      [expr {$w-$_warrow+1}]

    if { $data(base) > 0 } {
        if { ![llength [$path:cmd find withtag "leftarrow"]] } {
            $path:cmd create window $xl 1 \
                -width  $_warrow          \
                -height $h                \
                -anchor nw                \
                -window $path.fg          \
                -tags   "leftarrow"
        } else {
            $path:cmd coords "leftarrow" $xl 1
            $path:cmd itemconfigure "leftarrow" -width $_warrow -height $h
        }
    } else {
        $path:cmd delete "leftarrow"
    }

    if { $data(base) < $nbpages-1 &&
         $data(wpage) + [_get_x_page $path 0] + 6 > $w } {
        if { ![llength [$path:cmd find withtag "rightarrow"]] } {
            $path:cmd create window $xr 1 \
                -width  $_warrow          \
                -height $h                \
                -window $path.fd          \
                -anchor nw                \
                -tags   "rightarrow"
        } else {
            $path:cmd coords "rightarrow" $xr 1
            $path:cmd itemconfigure "rightarrow" -width $_warrow -height $h
        }
    } else {
        $path:cmd delete "rightarrow"
    }
}


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

    set w   [expr {[winfo width  $path]-1}]
    set h   [expr {[winfo height $path]-1}]
    set bd  [Widget::getoption $path -borderwidth]
    set x0  [expr {$bd-1}]
    set y0  $data(hpage)
    set y1  $h
    set dbg $data(dbg)
    set sel $data(select)
    if {  $sel == "" } {
        set xd  [expr {$w/2}]
        set xf  $xd
        set lbg $data(dbg)
    } else {
        set xd [_get_x_page $path [lsearch $data(pages) $data(select)]]
        set xf [expr {$xd + $data($sel,width)+6}]
        set lbg $data(lbg)
    }

    if { [llength [$path:cmd find withtag rect]] } {
        $path:cmd coords "toprect1" $xd $y0 $x0 $y0 $x0 $h
        $path:cmd coords "toprect2" $w $y0 $xf $y0
        $path:cmd coords "botrect"  $x0 $h $w $h $w $y0
        $path:cmd itemconfigure "toprect1" -fill $lbg -width $bd
        $path:cmd itemconfigure "toprect2" -fill $lbg -width $bd
        $path:cmd itemconfigure "botrect"  -width $bd
        $path:cmd raise "rect"
    } else {
        $path:cmd create line $xd $y0 $x0 $y0 $x0 $y1 \
            -tags "rect toprect1" -fill $lbg -width $bd
        $path:cmd create line $w $y0 $xf $y0 \
            -tags "rect toprect2" -fill $lbg -width $bd
        $path:cmd create line 1 $h $w $h $w $y0 \
            -tags "rect botrect"  -fill $dbg -width $bd
    }

    if { $sel != "" } {
        if { [llength [$path:cmd find withtag "window"]] } {
            $path:cmd coords "window" 2 [expr {$y0+1}]
            $path:cmd itemconfigure "window"    \
                -width  [expr {$w-3}]        \
                -height [expr {$h-$y0-3}]    \
                -window $path.f$sel
        } else {
            set y0 $data(hpage)
            $path:cmd create window 2 [expr {$y0+1}] \
                -width  [expr {$w-3}]           \
                -height [expr {$h-$y0-3}]       \
                -anchor nw                      \
                -tags   "window"                \
                -window $path.f$sel
        }
    } else {
        $path:cmd delete "window"
    }
}


# ------------------------------------------------------------------------------
#  Command NoteBook::_resize
# ------------------------------------------------------------------------------
proc NoteBook::_resize { path } {
    _draw_area   $path
    _draw_arrows $path
}


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

    if { [set width  [Widget::getoption $path -width]]  == 0 ||
         [set height [Widget::getoption $path -height]] == 0 } {
        compute_size $path
    }

    set data(realized) 1
    _draw_area $path
    _draw_arrows $path
    bind $path <Configure> "NoteBook::_resize $path"
}