notebook.tcl

notebook.tcl
This file is part of Unifix BWidget Toolkit
$Id: notebook.tcl,v 1.15 2002/10/14 20:56:22 hobbs 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


NoteBook
Comments  
Arguments  
Used by  
Uses  
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}
            {-foreground         String     ""     0}
            {-background         String     ""     0}
            {-activeforeground   String     ""     0}
            {-activebackground   String     ""     0}
            {-disabledforeground String     ""     0}
        }
    }

    Widget::bwinclude NoteBook ArrowButton .c.fg \
        include {-foreground -background -activeforeground \
        -activebackground -disabledforeground -repeatinterval \
        -repeatdelay -borderwidth} \
        initialize {-borderwidth 1}
    Widget::bwinclude NoteBook ArrowButton .c.fd \
        include {-foreground -background -activeforeground \
        -activebackground -disabledforeground -repeatinterval \
        -repeatdelay -borderwidth} \
        initialize {-borderwidth 1}

    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 0 {top bottom}}
        {-homogeneous        Boolean 0   0}
        {-borderwidth        Int 1   0 "%d >= 1 && %d <= 2"}
    {-internalborderwidth    Int 10  0 "%d >= 0"}
        {-width            Int 0   0 "%d >= 0"}
        {-height        Int 0   0 "%d >= 0"}

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

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

    {-arcradius             Int 2   0 "%d >= 0 && %d <= 8"}
    {-tabbevelsize          Int 0   0 "%d >= 0 && %d <= 8"}
    }

    Widget::addmap NoteBook "" .c {-background {}}

    variable _warrow 12

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


NoteBook::_compute_width
Comments Command NoteBook::_compute_width
Arguments path
Used by  
Uses Widget::cget
proc NoteBook::_compute_width { path } {
    variable $path
    upvar 0  $path data

    set font [Widget::cget $path -font]
    set wmax 0
    set hmax $data(hpage)
    set wtot 0
    if { ![info exists data(textid)] } {
        set data(textid) [$path.c create text 0 -100 -font $font -anchor nw]
    }
    set id $data(textid)
    $path.c itemconfigure $id -font $font
    foreach page $data(pages) {
        $path.c itemconfigure $id -text [Widget::cget $path.f$page -text]
    # Get the bbox for this text to determine its width, then substract
    # 6 from the width to account for canvas bbox oddness w.r.t. widths of
    # simple text.
    foreach {x1 y1 x2 y2} [$path.c bbox $id] break
    set x2 [expr {$x2 - 6}]
        set  wtext [expr {$x2 - $x1 + 20}]
        if { [set img [Widget::cget $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::cget $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
}


NoteBook::_destroy
Comments Command NoteBook::_destroy
Arguments path
Used by  
Uses Widget::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 {}
}


NoteBook::_draw_area
Comments Command NoteBook::_draw_area
Arguments path
Used by  
Uses Widget::cget
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"
    }
}


NoteBook::_draw_arrows
Comments Command NoteBook::_draw_arrows
Arguments path
Used by  
Uses Widget::cget
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"
    }
}


NoteBook::_draw_page
Comments Command NoteBook::_draw_page
Arguments path
page
create
Used by  
Uses NoteBook::_select
Widget::cget
NoteBook::_highlight
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  [_getoption $path $page -background]

    # lookup the tab colors
    set fgt   $data(lbg)
    set fgb   $data(dbg)

    set h   $data(hpage)
    set xd  [_get_x_page $path $pos]
    set xf  [expr {$xd + $data($page,width)}]

    # Set the initial text offsets -- a few pixels down, centered left-to-right
    set textOffsetY 3
    set textOffsetX 9

    # Coordinates of the tab corners are:
    #     c3        c4
    #
    # c2                c5
    #
    # 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 [list $path.c create polygon] [concat $lt $lb] [list \
        -tag        [list page p:$page $page:poly] \
        -outline    $bg \
        -fill        $bg \
        ]
        eval [list $path.c create line] $lt [list \
            -tags [list page p:$page $page:top top] -fill $fgt -width $bd]
        eval [list $path.c create line] $lb [list \
            -tags [list 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    [list page p:$page $page:text]

        $path.c bind p:$page <ButtonPress-1> \
        [list NoteBook::_select $path $page]
        $path.c bind p:$page <Enter> \
        [list NoteBook::_highlight on  $path $page]
        $path.c bind p:$page <Leave> \
        [list 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 [list $path.c coords "$page:poly"] [concat $lt $lb]
    eval [list $path.c coords "$page:top"]  $lt
    eval [list $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   [list 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}]]
        }
    }
}


NoteBook::_get_x_page
Comments Command NoteBook::_get_x_page
Arguments path
pos
Used by  
Uses  
proc NoteBook::_get_x_page { path pos } {
    variable _warrow
    variable $path
    upvar 0  $path data

    set base $data(base)
    # notebook tabs start flush with the left side of the notebook
    set x 0
    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
}


NoteBook::_getoption
Comments  
Arguments path
page
option
Used by  
Uses Widget::cget
proc NoteBook::_getoption { path page option } {
    set value [Widget::cget $path.f$page $option]
    if {![string length $value]} {
        set value [Widget::cget $path $option]
    }
    return $value
}


NoteBook::_highlight
Comments Command NoteBook::_highlight
Arguments type
path
page
Used by NoteBook::_draw_page
Uses Widget::cget
proc NoteBook::_highlight { type path page } {
    variable $path
    upvar 0  $path data

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

    switch -- $type {
        on {
            $path.c itemconfigure "$page:poly" \
            -fill [_getoption $path $page -activebackground]
            $path.c itemconfigure "$page:text" \
            -fill [_getoption $path $page -activeforeground]
        }
        off {
            $path.c itemconfigure "$page:poly" \
            -fill [_getoption $path $page -background]
            $path.c itemconfigure "$page:text" \
            -fill [_getoption $path $page -foreground]
        }
    }
}


NoteBook::_itemconfigure
Comments Command NoteBook::_itemconfigure
Arguments path
page
lres
Used by  
Uses Widget::configure
Widget::cget
Widget::hasChanged
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] } {
        _compute_width $path
    } elseif  { [Widget::hasChanged $path.f$page -image foo] } {
        set data(hpage) [expr {[font metrics [Widget::cget $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
}


NoteBook::_realize
Comments Command NoteBook::_realize
Arguments path
Used by  
Uses Widget::cget
NoteBook::_redraw
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"
}


NoteBook::_redraw
Comments Command NoteBook::_redraw
Arguments path
Used by NoteBook::_resize
NoteBook::_realize
NoteBook::compute_size
Uses  
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
}


NoteBook::_resize
Comments Command NoteBook::_resize
Arguments path
Used by  
Uses NoteBook::_redraw
proc NoteBook::_resize { path } {
    # Sven
    NoteBook::_redraw $path
    # Sven
}


NoteBook::_select
Comments Command NoteBook::_select
Arguments path
page
Used by NoteBook::_draw_page
Uses Widget::cget
proc NoteBook::_select { path page } {
    variable $path
    upvar 0  $path data

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


NoteBook::_test_page
Comments Command NoteBook::_test_page
Arguments path
page
Used by  
Uses  
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
}


NoteBook::_xview
Comments Command NoteBook::_xview
Arguments path
inc
Used by  
Uses  
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.c move page $dx 0
        _draw_area   $path
        _draw_arrows $path
    }
}


NoteBook::bindtabs
Comments Command NoteBook::bindtabs
Arguments path
event
script
Used by  
Uses  
proc NoteBook::bindtabs { path event script } {
    if { $script != "" } {
        $path.c bind "page" $event \
            "$script \[string range \[lindex \[$path.c gettags current\] 1\] 2 end\]"
    } else {
        $path.c bind "page" $event {}
    }
}


NoteBook::cget
Comments Command NoteBook::cget
Arguments path
option
Used by  
Uses Widget::cget
proc NoteBook::cget { path option } {
    return [Widget::cget $path $option]
}


NoteBook::compute_size
Comments Command NoteBook::compute_size
Arguments path
Used by  
Uses NoteBook::_redraw
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
    # Sven... well ok so this is called twice in some cases...
    NoteBook::_redraw $path
    # Sven end
}


NoteBook::configure
Comments Command NoteBook::configure
Arguments path
args
Used by  
Uses Widget::configure
BWidget::get3dcolor
Widget::hasChanged
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
    }
    set chibd [Widget::hasChanged $path -internalborderwidth ibd]
    set chbg  [Widget::hasChanged $path -background bg]
    if {$chibd || $chbg} {
        foreach page $data(pages) {
            $path.f$page configure \
                -borderwidth $ibd -background $bg
        }
    }

    if {$chbg} {
        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] ||
     [Widget::hasChanged $path -arcradius radius] ||
         [Widget::hasChanged $path -tabbevelsize bevel] ||
         [Widget::hasChanged $path -side side] } {
        set redraw 1
    }
    set wc [Widget::hasChanged $path -width  w]
    set hc [Widget::hasChanged $path -height h]
    if { $wc || $hc } {
        $path.c configure \
        -width [expr {$w+4}] \
        -height [expr {$h + $data(hpage)+4}]
    }
    if { $redraw } {
        _redraw $path
    }

    return $res
}


NoteBook::create
Comments Command NoteBook::create
Arguments path
args
Used by  
Uses ArrowButton::create
Widget::init
Widget::subcget
BWidget::get3dcolor
Widget::cget
proc NoteBook::create { path args } {
    variable $path
    upvar 0  $path data

    Widget::init NoteBook $path $args

    set font [Widget::cget $path -font]
    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 $font -linespace] + 6}]

    # Create the canvas
    set w [expr {[Widget::cget $path -width]+4}]
    set h [expr {[Widget::cget $path -height]+$data(hpage)+4}]

    frame $path -class NoteBook -borderwidth 0 -highlightthickness 0 \
        -relief flat
    eval canvas $path.c            \
        [Widget::subcget $path .c] \
        -relief flat        \
        -borderwidth 0        \
        -highlightthickness 0    \
        -width $w            \
        -height $h
    pack $path.c -expand yes -fill both

    # Removing the Canvas global bindings from our canvas as
    # application specific bindings on that tag may interfere with its
    # operation here. [SF item #459033]

    set bindings [bindtags $path.c]
    set pos [lsearch -exact $bindings Canvas]
    if {$pos >= 0} {
    set bindings [lreplace $bindings $pos $pos]
    }
    bindtags $path.c $bindings

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

    eval ArrowButton::create $path.c.fd [Widget::subcget $path .c.fd] \
        -highlightthickness 0 \
        -type button  -dir right \
        -armcommand [list "NoteBook::_xview $path 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\]"

    set bg [Widget::cget $path -background]
    foreach {data(dbg) data(lbg)} [BWidget::get3dcolor $path $bg] {break}

    return $path
}


NoteBook::delete
Comments Command NoteBook::delete
Arguments path
page
destroyframe
Used by  
Uses  
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.c 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
}


NoteBook::getframe
Comments Command NoteBook::getframe
Arguments path
page
Used by  
Uses  
proc NoteBook::getframe { path page } {
    return $path.f$page
}


NoteBook::index
Comments Command NoteBook::index
Arguments path
page
Used by  
Uses  
proc NoteBook::index { path page } {
    variable $path
    upvar 0  $path data

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


NoteBook::insert
Comments Command NoteBook::insert
Arguments path
index
page
args
Used by  
Uses Widget::init
Widget::cget
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 the page doesn't exist, create it; if it does reset its bg and ibd
    if { ![winfo exists $path.f$page] } {
        frame $path.f$page                         \
        -relief flat                        \
        -background    [Widget::cget $path -background]    \
        -borderwidth    [Widget::cget $path -internalborderwidth]
        set data($page,realized) 0
    } else {
    $path.f$page configure                        \
        -background    [Widget::cget $path -background]    \
        -borderwidth    [Widget::cget $path -internalborderwidth]
    }
    _compute_width $path
    _draw_page $path $page 1
    _redraw $path

    return $path.f$page
}


NoteBook::itemcget
Comments Command NoteBook::itemcget
Arguments path
page
option
Used by  
Uses Widget::cget
proc NoteBook::itemcget { path page option } {
    _test_page $path $page
    return [Widget::cget $path.f$page $option]
}


NoteBook::itemconfigure
Comments Command NoteBook::itemconfigure
Arguments path
page
args
Used by  
Uses  
proc NoteBook::itemconfigure { path page args } {
    _test_page $path $page
    set res [_itemconfigure $path $page $args]
    _redraw $path

    return $res
}


NoteBook::move
Comments Command NoteBook::move
Arguments path
page
index
Used by  
Uses  
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
}


NoteBook::page
Comments Command NoteBook::page
Arguments path
first
last
Used by  
Uses  
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]
    }
}


NoteBook::pages
Comments Command NoteBook::pages
Arguments path
first
last
Used by  
Uses  
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]
    }
}


NoteBook::raise
Comments Command NoteBook::raise
Arguments path
page
Used by  
Uses  
proc NoteBook::raise { path {page ""} } {
    variable $path
    upvar 0  $path data

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


NoteBook::see
Comments Command NoteBook::see
Arguments path
page
Used by  
Uses  
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
        }
    }
}
generated by zdoc.tcl on 2003-03-06 00:21:54