notebook.tcl

是TCL的另外一个编译（解释）器

    #
    # c1                c6
    #
    # where
    # c1 = $xd,	  $h
    # c2 = $xd+$xBevel,	           $arcRadius+2
    # c3 = $xd+$xBevel+$arcRadius, $arcRadius
    # c4 = $xf+1-$xBevel,          $arcRadius
    # c5 = $xf+$arcRadius-$xBevel, $arcRadius+2
    # c6 = $xf+$arcRadius,         $h

    set top		2
    set arcRadius	[Widget::cget $path -arcradius]
    set xBevel		[Widget::cget $path -tabbevelsize]

    if { $data(select) != $page } {
	if { $pos == 0 } {
	    # The leftmost page is a special case -- it is drawn with its
	    # tab a little indented.  To achieve this, we incr xd.  We also
	    # decr textOffsetX, so that the text doesn't move left/right.
	    incr xd 2
	    incr textOffsetX -2
	}
    } else {
	# The selected page's text is raised higher than the others
	incr top -2
    }

    # Precompute some coord values that we use a lot
    set topPlusRadius	[expr {$top + $arcRadius}]
    set rightPlusRadius	[expr {$xf + $arcRadius}]
    set leftPlusRadius	[expr {$xd + $arcRadius}]

    # Sven
    set side [Widget::cget $path -side]
    set tabsOnBottom [string equal $side "bottom"]

    set h1 [expr {[winfo height $path]}]
    set bd [Widget::cget $path -borderwidth]

    if { $tabsOnBottom } {
	set top [expr {$top * -1}]
	set topPlusRadius [expr {$topPlusRadius * -1}]
	# Hrm... the canvas has an issue with drawing diagonal segments
	# of lines from the bottom to the top, so we have to draw this line
	# backwards (ie, lt is actually the bottom, drawn from right to left)
        set lt  [list 					\
		$rightPlusRadius	[expr {$h1-$h-1}]		\
		[expr {$rightPlusRadius - $xBevel}]	[expr {$h1 + $topPlusRadius}]	\
		[expr {$xf - $xBevel}]			[expr {$h1 + $top}]		\
		[expr {$leftPlusRadius + $xBevel}]	[expr {$h1 + $top}]		\
		]
        set lb  [list					\
		[expr {$leftPlusRadius + $xBevel}]	[expr {$h1 + $top}]		\
		[expr {$xd + $xBevel}]			[expr {$h1 + $topPlusRadius}]	\
		$xd			[expr {$h1-$h-1}]	\
		]
	# Because we have to do this funky reverse order thing, we have to
	# swap the top/bottom colors too.
	set tmp $fgt
	set fgt $fgb
	set fgb $tmp
    } else {
	set lt [list					\
		$xd			$h		\
		[expr {$xd + $xBevel}]			$topPlusRadius		\
		[expr {$leftPlusRadius + $xBevel}]	$top			\
		[expr {$xf + 1 - $xBevel}]		$top			\
		]
	set lb [list 						\
		[expr {$xf + 1 - $xBevel}] 		[expr {$top + 1}]	\
		[expr {$rightPlusRadius - $xBevel}]	$topPlusRadius		\
		$rightPlusRadius	$h			\
		]
    }

    set img [Widget::cget $path.f$page -image]

    set ytext $top
    if { $tabsOnBottom } {
	# The "+ 2" below moves the text closer to the bottom of the tab,
	# so it doesn't look so cramped.  I should be able to achieve the
	# same goal by changing the anchor of the text and using this formula:
	# ytext = $top + $h1 - $textOffsetY
	# but that doesn't quite work (I think the linespace from the text
	# gets in the way)
	incr ytext [expr {$h1 - $h + 2}]
    }
    incr ytext $textOffsetY

    set xtext [expr {$xd + $textOffsetX}]
    if { $img != "" } {
	# if there's an image, put it on the left and move the text right
	set ximg $xtext
	incr xtext [expr {[image width $img] + 2}]
    }
	
    if { $data(select) == $page } {
        set bd    [Widget::cget $path -borderwidth]
        set fg    [_getoption $path $page -foreground]
    } else {
        set bd    1
        if { [Widget::cget $path.f$page -state] == "normal" } {
            set fg [_getoption $path $page -foreground]
        } else {
            set fg [_getoption $path $page -disabledforeground]
        }
    }

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

        $path.c bind p:$page <ButtonPress-1> "NoteBook::_select $path $page"
        $path.c bind p:$page <Enter>         "NoteBook::_highlight on  $path $page"
        $path.c bind p:$page <Leave>         "NoteBook::_highlight off $path $page"
    } else {
        $path.c coords "$page:text" $xtext $ytext

        $path.c itemconfigure "$page:text"    \
            -text [Widget::cget $path.f$page -text]     \
            -font [Widget::cget $path -font]    \
            -fill $fg
    }
    eval $path.c coords "$page:poly" [concat $lt $lb]
    eval $path.c coords "$page:top"  $lt
    eval $path.c coords "$page:bot"  $lb
    $path.c itemconfigure "$page:poly" -fill $bg  -outline $bg
    $path.c itemconfigure "$page:top"  -fill $fgt -width $bd
    $path.c itemconfigure "$page:bot"  -fill $fgb -width $bd
    
    # Sven end
        
    if { $img != "" } {
        # Sven
	set id [$path.c find withtag $page:img]
	if { [string equal $id ""] } {
	    set id [$path.c create image $ximg $ytext \
		    -anchor nw    \
		    -tags   "page p:$page $page:img"]
        }
        $path.c coords $id $ximg $ytext
        $path.c itemconfigure $id -image $img
        # Sven end
    } else {
        $path.c delete $page:img
    }

    if { $data(select) == $page } {
        $path.c raise p:$page
    } elseif { $pos == 0 } {
        if { $data(select) == "" } {
            $path.c raise p:$page
        } else {
            $path.c lower p:$page p:$data(select)
        }
    } else {
        set pred [lindex $data(pages) [expr {$pos-1}]]
        if { $data(select) != $pred || $pos == 1 } {
            $path.c lower p:$page p:$pred
        } else {
            $path.c 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}]
    # Sven
    set side [Widget::cget $path -side]
    if { [string equal $side "bottom"] } {
        set h1 [expr {[winfo height $path]-1}]
        set bd [Widget::cget $path -borderwidth]
        set y0 [expr {$h1 - $data(hpage) + $bd}]
    } else {
        set y0 1
    }
    # Sven end (all y positions where replaced with $y0 later)

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

    if { $data(base) < $nbpages-1 &&
         $data(wpage) + [_get_x_page $path 0] + 6 > $w } {
        # Sven
        if { ![llength [$path.c find withtag "rightarrow"]] } {
            $path.c create window $xr $y0 \
                -width  $_warrow            \
                -height $h                  \
                -window $path.c.fd            \
                -anchor nw                  \
                -tags   "rightarrow"
        } else {
            $path.c coords "rightarrow" $xr $y0
            $path.c itemconfigure "rightarrow" -width $_warrow -height $h
        }
        # Sven end
    } else {
        $path.c 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::cget $path -borderwidth]
    set x0  [expr {$bd-1}]

    set arcRadius	[Widget::cget $path -arcradius]

    # Sven
    set side [Widget::cget $path -side]
    if {"$side" == "bottom"} {
        set y0 0
        set y1 [expr {$h - $data(hpage)}]
        set yo $y1
    } else {
        set y0 $data(hpage)
        set y1 $h
        set yo [expr {$h-$y0}]
    }
    # Sven end
    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) + $arcRadius + 1}]
        set lbg $data(lbg)
    }

    # Sven
    if { [llength [$path.c find withtag rect]] == 0} {
        $path.c create line $xd $y0 $x0 $y0 $x0 $y1 \
            -tags "rect toprect1" 
        $path.c create line $w $y0 $xf $y0 \
            -tags "rect toprect2"
        $path.c create line 1 $h $w $h $w $y0 \
            -tags "rect botrect"
    }
    if {"$side" == "bottom"} {
        $path.c coords "toprect1" $w $y0 $x0 $y0 $x0 $y1
        $path.c coords "toprect2" $x0 $y1 $xd $y1
        $path.c coords "botrect"  $xf $y1 $w $y1 $w $y0
        $path.c itemconfigure "toprect1" -fill $lbg -width $bd
        $path.c itemconfigure "toprect2" -fill $dbg -width $bd
        $path.c itemconfigure "botrect" -fill $dbg -width $bd
    } else {
        $path.c coords "toprect1" $xd $y0 $x0 $y0 $x0 $y1
        $path.c coords "toprect2" $w $y0 $xf $y0
        $path.c coords "botrect"  $x0 $h $w $h $w $y0
        $path.c itemconfigure "toprect1" -fill $lbg -width $bd
        $path.c itemconfigure "toprect2" -fill $lbg -width $bd
        $path.c itemconfigure "botrect" -fill $dbg -width $bd
    }
    $path.c raise "rect"
    # Sven end

    if { $sel != "" } {
        # Sven
        if { [llength [$path.c find withtag "window"]] == 0 } {
            $path.c create window 2 [expr {$y0+1}] \
                -width  [expr {$w-3}]           \
                -height [expr {$yo-3}]          \
                -anchor nw                      \
                -tags   "window"                \
                -window $path.f$sel
        }
        $path.c coords "window" 2 [expr {$y0+1}]
        $path.c itemconfigure "window"    \
            -width  [expr {$w-3}]           \
            -height [expr {$yo-3}]          \
            -window $path.f$sel
        # Sven end
    } else {
        $path.c delete "window"
    }
}


# -----------------------------------------------------------------------------
#  Command NoteBook::_resize
# -----------------------------------------------------------------------------
proc NoteBook::_resize { path } {
    # Sven
    NoteBook::_redraw $path
    # Sven
}


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

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

    set data(realized) 1
    # Sven
    NoteBook::_redraw $path
    # Sven
    bind $path <Configure> "NoteBook::_resize $path"
}