# ---------------------------------------------------------------------------#  notebook.tcl#  This file is part of Unifix BWidget Toolkit#  $Id: notebook.tcl 4194 2005-03-02 22:21:22Z gadget_boy $# ---------------------------------------------------------------------------#  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# ---------------------------------------------------------------------------namespace eval NoteBook {    Widget::define NoteBook notebook ArrowButton DynamicHelp    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}        }    }    DynamicHelp::include NoteBook::Page balloon    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"}        {-tabpady            Padding {0 6} 0 "%d >= 0"}    }    Widget::addmap NoteBook "" .c {-background {}}    variable _warrow 12    bind NoteBook <Configure> [list NoteBook::_resize  %W]    bind NoteBook <Destroy>   [list NoteBook::_destroy %W]}# ---------------------------------------------------------------------------#  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    _compute_height $path    # 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 [list canvas $path.c] [Widget::subcget $path .c] \	    [list -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 [list ArrowButton::create $path.c.fg] [Widget::subcget $path .c.fg] \	    [list -highlightthickness 0 -type button -dir left \	    -armcommand [list NoteBook::_xview $path -1]]    eval [list ArrowButton::create $path.c.fd] [Widget::subcget $path .c.fd] \	    [list -highlightthickness 0 -type button -dir right \	    -armcommand [list NoteBook::_xview $path 1]]    Widget::create NoteBook $path    set bg [Widget::cget $path -background]    foreach {data(dbg) data(lbg)} [BWidget::get3dcolor $path $bg] {break}    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    set opts [list -font -homogeneous -tabpady]    foreach {cf ch cp} [eval Widget::hasChangedX $path $opts] {break}    if {$cf || $ch || $cp} {        if { $cf || $cp } {            _compute_height $path        }        _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}# ---------------------------------------------------------------------------#  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    # Sven... well ok so this is called twice in some cases...    NoteBook::_redraw $path    # Sven end}# ---------------------------------------------------------------------------#  Command NoteBook::insert# ---------------------------------------------------------------------------proc NoteBook::insert { path index page args } {    variable $path    upvar 0  $path data    if { [lsearch -exact $data(pages) $page] != -1 } {        return -code error "page \"$page\" already exists"    }    set f $path.f$page    Widget::init NoteBook::Page $f $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 $f] } {        frame $f \	    -relief      flat \	    -background  [Widget::cget $path -background] \	    -borderwidth [Widget::cget $path -internalborderwidth]        set data($page,realized) 0    } else {	$f configure \	    -background  [Widget::cget $path -background] \	    -borderwidth [Widget::cget $path -internalborderwidth]    }    _compute_height $path    _compute_width  $path    _draw_page $path $page 1    _set_help  $path $page    _redraw $path    return $f}# ---------------------------------------------------------------------------#  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.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}# ---------------------------------------------------------------------------#  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 != "" } {	append script " \[NoteBook::_get_page_name [list $path] current 2\]"        $path.c bind "page" $event $script    } else {        $path.c 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