1# ---------------------------------------------------------------------------
2#  notebook.tcl
3#  This file is part of Unifix BWidget Toolkit
4#  $Id: notebook.tcl 606 2004-04-05 07:06:06Z mcourtoi $
5# ---------------------------------------------------------------------------
6#  Index of commands:
7#     - NoteBook::create
8#     - NoteBook::configure
9#     - NoteBook::cget
10#     - NoteBook::compute_size
11#     - NoteBook::insert
12#     - NoteBook::delete
13#     - NoteBook::itemconfigure
14#     - NoteBook::itemcget
15#     - NoteBook::bindtabs
16#     - NoteBook::raise
17#     - NoteBook::see
18#     - NoteBook::page
19#     - NoteBook::pages
20#     - NoteBook::index
21#     - NoteBook::getframe
22#     - NoteBook::_test_page
23#     - NoteBook::_itemconfigure
24#     - NoteBook::_compute_width
25#     - NoteBook::_get_x_page
26#     - NoteBook::_xview
27#     - NoteBook::_highlight
28#     - NoteBook::_select
29#     - NoteBook::_redraw
30#     - NoteBook::_draw_page
31#     - NoteBook::_draw_arrows
32#     - NoteBook::_draw_area
33#     - NoteBook::_resize
34# ---------------------------------------------------------------------------
35
36namespace eval NoteBook {
37    Widget::define NoteBook notebook ArrowButton DynamicHelp
38
39    namespace eval Page {
40        Widget::declare NoteBook::Page {
41            {-state      Enum       normal 0 {normal disabled}}
42            {-createcmd  String     ""     0}
43            {-raisecmd   String     ""     0}
44            {-leavecmd   String     ""     0}
45            {-image      TkResource ""     0 label}
46            {-text       String     ""     0}
47            {-foreground         String     ""     0}
48            {-background         String     ""     0}
49            {-activeforeground   String     ""     0}
50            {-activebackground   String     ""     0}
51            {-disabledforeground String     ""     0}
52        }
53    }
54
55    DynamicHelp::include NoteBook::Page balloon
56
57    Widget::bwinclude NoteBook ArrowButton .c.fg \
58	    include {-foreground -background -activeforeground \
59		-activebackground -disabledforeground -repeatinterval \
60		-repeatdelay -borderwidth} \
61	    initialize {-borderwidth 1}
62    Widget::bwinclude NoteBook ArrowButton .c.fd \
63	    include {-foreground -background -activeforeground \
64		-activebackground -disabledforeground -repeatinterval \
65		-repeatdelay -borderwidth} \
66	    initialize {-borderwidth 1}
67
68    Widget::declare NoteBook {
69	{-foreground		TkResource "" 0 button}
70        {-background		TkResource "" 0 button}
71        {-activebackground	TkResource "" 0 button}
72        {-activeforeground	TkResource "" 0 button}
73        {-disabledforeground	TkResource "" 0 button}
74        {-font			TkResource "" 0 button}
75        {-side			Enum       top 0 {top bottom}}
76        {-homogeneous		Boolean 0   0}
77        {-borderwidth		Int 1   0 "%d >= 1 && %d <= 2"}
78 	{-internalborderwidth	Int 10  0 "%d >= 0"}
79        {-width			Int 0   0 "%d >= 0"}
80        {-height		Int 0   0 "%d >= 0"}
81
82        {-repeatdelay        BwResource ""  0 ArrowButton}
83        {-repeatinterval     BwResource ""  0 ArrowButton}
84
85        {-fg                 Synonym -foreground}
86        {-bg                 Synonym -background}
87        {-bd                 Synonym -borderwidth}
88        {-ibd                Synonym -internalborderwidth}
89
90	{-arcradius          Int     2     0 "%d >= 0 && %d <= 8"}
91	{-tabbevelsize       Int     0     0 "%d >= 0 && %d <= 8"}
92        {-tabpady            Padding {0 6} 0 "%d >= 0"}
93    }
94
95    Widget::addmap NoteBook "" .c {-background {}}
96
97    variable _warrow 12
98
99    bind NoteBook <Configure> [list NoteBook::_resize  %W]
100    bind NoteBook <Destroy>   [list NoteBook::_destroy %W]
101}
102
103
104# ---------------------------------------------------------------------------
105#  Command NoteBook::create
106# ---------------------------------------------------------------------------
107proc NoteBook::create { path args } {
108    variable $path
109    upvar 0  $path data
110
111    Widget::init NoteBook $path $args
112
113    set data(base)     0
114    set data(select)   ""
115    set data(pages)    {}
116    set data(pages)    {}
117    set data(cpt)      0
118    set data(realized) 0
119    set data(wpage)    0
120
121    _compute_height $path
122
123    # Create the canvas
124    set w [expr {[Widget::cget $path -width]+4}]
125    set h [expr {[Widget::cget $path -height]+$data(hpage)+4}]
126
127    frame $path -class NoteBook -borderwidth 0 -highlightthickness 0 \
128	    -relief flat
129    eval [list canvas $path.c] [Widget::subcget $path .c] \
130	    [list -relief flat -borderwidth 0 -highlightthickness 0 \
131	    -width $w -height $h]
132    pack $path.c -expand yes -fill both
133
134    # Removing the Canvas global bindings from our canvas as
135    # application specific bindings on that tag may interfere with its
136    # operation here. [SF item #459033]
137
138    set bindings [bindtags $path.c]
139    set pos [lsearch -exact $bindings Canvas]
140    if {$pos >= 0} {
141	set bindings [lreplace $bindings $pos $pos]
142    }
143    bindtags $path.c $bindings
144
145    # Create the arrow button
146    eval [list ArrowButton::create $path.c.fg] [Widget::subcget $path .c.fg] \
147	    [list -highlightthickness 0 -type button -dir left \
148	    -armcommand [list NoteBook::_xview $path -1]]
149
150    eval [list ArrowButton::create $path.c.fd] [Widget::subcget $path .c.fd] \
151	    [list -highlightthickness 0 -type button -dir right \
152	    -armcommand [list NoteBook::_xview $path 1]]
153
154    Widget::create NoteBook $path
155
156    set bg [Widget::cget $path -background]
157    foreach {data(dbg) data(lbg)} [BWidget::get3dcolor $path $bg] {break}
158
159    return $path
160}
161
162
163# ---------------------------------------------------------------------------
164#  Command NoteBook::configure
165# ---------------------------------------------------------------------------
166proc NoteBook::configure { path args } {
167    variable $path
168    upvar 0  $path data
169
170    set res [Widget::configure $path $args]
171    set redraw 0
172    set opts [list -font -homogeneous -tabpady]
173    foreach {cf ch cp} [eval Widget::hasChangedX $path $opts] {break}
174    if {$cf || $ch || $cp} {
175        if { $cf || $cp } {
176            _compute_height $path
177        }
178        _compute_width $path
179        set redraw 1
180    }
181    set chibd [Widget::hasChanged $path -internalborderwidth ibd]
182    set chbg  [Widget::hasChanged $path -background bg]
183    if {$chibd || $chbg} {
184        foreach page $data(pages) {
185            $path.f$page configure \
186                -borderwidth $ibd -background $bg
187        }
188    }
189
190    if {$chbg} {
191        set col [BWidget::get3dcolor $path $bg]
192        set data(dbg)  [lindex $col 0]
193        set data(lbg)  [lindex $col 1]
194        set redraw 1
195    }
196    if { [Widget::hasChanged $path -foreground  fg] ||
197         [Widget::hasChanged $path -borderwidth bd] ||
198	 [Widget::hasChanged $path -arcradius radius] ||
199         [Widget::hasChanged $path -tabbevelsize bevel] ||
200         [Widget::hasChanged $path -side side] } {
201        set redraw 1
202    }
203    set wc [Widget::hasChanged $path -width  w]
204    set hc [Widget::hasChanged $path -height h]
205    if { $wc || $hc } {
206        $path.c configure \
207		-width  [expr {$w + 4}] \
208		-height [expr {$h + $data(hpage) + 4}]
209    }
210    if { $redraw } {
211        _redraw $path
212    }
213
214    return $res
215}
216
217
218# ---------------------------------------------------------------------------
219#  Command NoteBook::cget
220# ---------------------------------------------------------------------------
221proc NoteBook::cget { path option } {
222    return [Widget::cget $path $option]
223}
224
225
226# ---------------------------------------------------------------------------
227#  Command NoteBook::compute_size
228# ---------------------------------------------------------------------------
229proc NoteBook::compute_size { path } {
230    variable $path
231    upvar 0  $path data
232
233    set wmax 0
234    set hmax 0
235    update idletasks
236    foreach page $data(pages) {
237        set w    [winfo reqwidth  $path.f$page]
238        set h    [winfo reqheight $path.f$page]
239        set wmax [expr {$w>$wmax ? $w : $wmax}]
240        set hmax [expr {$h>$hmax ? $h : $hmax}]
241    }
242    configure $path -width $wmax -height $hmax
243    # Sven... well ok so this is called twice in some cases...
244    NoteBook::_redraw $path
245    # Sven end
246}
247
248
249# ---------------------------------------------------------------------------
250#  Command NoteBook::insert
251# ---------------------------------------------------------------------------
252proc NoteBook::insert { path index page args } {
253    variable $path
254    upvar 0  $path data
255
256    if { [lsearch -exact $data(pages) $page] != -1 } {
257        return -code error "page \"$page\" already exists"
258    }
259
260    set f $path.f$page
261    Widget::init NoteBook::Page $f $args
262
263    set data(pages) [linsert $data(pages) $index $page]
264    # If the page doesn't exist, create it; if it does reset its bg and ibd
265    if { ![winfo exists $f] } {
266        frame $f \
267	    -relief      flat \
268	    -background  [Widget::cget $path -background] \
269	    -borderwidth [Widget::cget $path -internalborderwidth]
270        set data($page,realized) 0
271    } else {
272	$f configure \
273	    -background  [Widget::cget $path -background] \
274	    -borderwidth [Widget::cget $path -internalborderwidth]
275    }
276    _compute_height $path
277    _compute_width  $path
278    _draw_page $path $page 1
279    _set_help  $path $page
280    _redraw $path
281
282    return $f
283}
284
285
286# ---------------------------------------------------------------------------
287#  Command NoteBook::delete
288# ---------------------------------------------------------------------------
289proc NoteBook::delete { path page {destroyframe 1} } {
290    variable $path
291    upvar 0  $path data
292
293    set pos [_test_page $path $page]
294    set data(pages) [lreplace $data(pages) $pos $pos]
295    _compute_width $path
296    $path.c delete p:$page
297    if { $data(select) == $page } {
298        set data(select) ""
299    }
300    if { $pos < $data(base) } {
301        incr data(base) -1
302    }
303    if { $destroyframe } {
304        destroy $path.f$page
305    }
306    _redraw $path
307}
308
309
310# ---------------------------------------------------------------------------
311#  Command NoteBook::itemconfigure
312# ---------------------------------------------------------------------------
313proc NoteBook::itemconfigure { path page args } {
314    _test_page $path $page
315    set res [_itemconfigure $path $page $args]
316    _redraw $path
317
318    return $res
319}
320
321
322# ---------------------------------------------------------------------------
323#  Command NoteBook::itemcget
324# ---------------------------------------------------------------------------
325proc NoteBook::itemcget { path page option } {
326    _test_page $path $page
327    return [Widget::cget $path.f$page $option]
328}
329
330
331# ---------------------------------------------------------------------------
332#  Command NoteBook::bindtabs
333# ---------------------------------------------------------------------------
334proc NoteBook::bindtabs { path event script } {
335    if { $script != "" } {
336	append script " \[NoteBook::_get_page_name [list $path] current 2\]"
337        $path.c bind "page" $event $script
338    } else {
339        $path.c bind "page" $event {}
340    }
341}
342
343
344# ---------------------------------------------------------------------------
345#  Command NoteBook::move
346# ---------------------------------------------------------------------------
347proc NoteBook::move { path page index } {
348    variable $path
349    upvar 0  $path data
350
351    set pos [_test_page $path $page]
352    set data(pages) [linsert [lreplace $data(pages) $pos $pos] $index $page]
353    _redraw $path
354}
355
356
357# ---------------------------------------------------------------------------
358#  Command NoteBook::raise
359# ---------------------------------------------------------------------------
360proc NoteBook::raise { path {page ""} } {
361    variable $path
362    upvar 0  $path data
363
364    if { $page != "" } {
365        _test_page $path $page
366        _select $path $page
367    }
368    return $data(select)
369}
370
371
372# ---------------------------------------------------------------------------
373#  Command NoteBook::see
374# ---------------------------------------------------------------------------
375proc NoteBook::see { path page } {
376    variable $path
377    upvar 0  $path data
378
379    set pos [_test_page $path $page]
380    if { $pos < $data(base) } {
381        set data(base) $pos
382        _redraw $path
383    } else {
384        set w     [expr {[winfo width $path]-1}]
385        set fpage [expr {[_get_x_page $path $pos] + $data($page,width) + 6}]
386        set idx   $data(base)
387        while { $idx < $pos && $fpage > $w } {
388            set fpage [expr {$fpage - $data([lindex $data(pages) $idx],width)}]
389            incr idx
390        }
391        if { $idx != $data(base) } {
392            set data(base) $idx
393            _redraw $path
394        }
395    }
396}
397
398
399# ---------------------------------------------------------------------------
400#  Command NoteBook::page
401# ---------------------------------------------------------------------------
402proc NoteBook::page { path first {last ""} } {
403    variable $path
404    upvar 0  $path data
405
406    if { $last == "" } {
407        return [lindex $data(pages) $first]
408    } else {
409        return [lrange $data(pages) $first $last]
410    }
411}
412
413
414# ---------------------------------------------------------------------------
415#  Command NoteBook::pages
416# ---------------------------------------------------------------------------
417proc NoteBook::pages { path {first ""} {last ""}} {
418    variable $path
419    upvar 0  $path data
420
421    if { ![string length $first] } {
422	return $data(pages)
423    }
424
425    if { ![string length $last] } {
426        return [lindex $data(pages) $first]
427    } else {
428        return [lrange $data(pages) $first $last]
429    }
430}
431
432
433# ---------------------------------------------------------------------------
434#  Command NoteBook::index
435# ---------------------------------------------------------------------------
436proc NoteBook::index { path page } {
437    variable $path
438    upvar 0  $path data
439
440    return [lsearch -exact $data(pages) $page]
441}
442
443
444# ---------------------------------------------------------------------------
445#  Command NoteBook::_destroy
446# ---------------------------------------------------------------------------
447proc NoteBook::_destroy { path } {
448    variable $path
449    upvar 0  $path data
450
451    foreach page $data(pages) {
452        Widget::destroy $path.f$page
453    }
454    Widget::destroy $path
455    unset data
456}
457
458
459# ---------------------------------------------------------------------------
460#  Command NoteBook::getframe
461# ---------------------------------------------------------------------------
462proc NoteBook::getframe { path page } {
463    return $path.f$page
464}
465
466
467# ---------------------------------------------------------------------------
468#  Command NoteBook::_test_page
469# ---------------------------------------------------------------------------
470proc NoteBook::_test_page { path page } {
471    variable $path
472    upvar 0  $path data
473
474    if { [set pos [lsearch -exact $data(pages) $page]] == -1 } {
475        return -code error "page \"$page\" does not exists"
476    }
477    return $pos
478}
479
480proc NoteBook::_getoption { path page option } {
481    set value [Widget::cget $path.f$page $option]
482    if {![string length $value]} {
483        set value [Widget::cget $path $option]
484    }
485    return $value
486}
487
488# ---------------------------------------------------------------------------
489#  Command NoteBook::_itemconfigure
490# ---------------------------------------------------------------------------
491proc NoteBook::_itemconfigure { path page lres } {
492    variable $path
493    upvar 0  $path data
494
495    set res [Widget::configure $path.f$page $lres]
496    if { [Widget::hasChanged $path.f$page -text foo] } {
497        _compute_width $path
498    } elseif  { [Widget::hasChanged $path.f$page -image foo] } {
499        _compute_height $path
500        _compute_width  $path
501    }
502    if { [Widget::hasChanged $path.f$page -state state] &&
503         $state == "disabled" && $data(select) == $page } {
504        set data(select) ""
505    }
506    return $res
507}
508
509
510# ---------------------------------------------------------------------------
511#  Command NoteBook::_compute_width
512# ---------------------------------------------------------------------------
513proc NoteBook::_compute_width { path } {
514    variable $path
515    upvar 0  $path data
516
517    set wmax 0
518    set wtot 0
519    set hmax $data(hpage)
520    set font [Widget::cget $path -font]
521    if { ![info exists data(textid)] } {
522        set data(textid) [$path.c create text 0 -100 -font $font -anchor nw]
523    }
524    set id $data(textid)
525    $path.c itemconfigure $id -font $font
526    foreach page $data(pages) {
527        $path.c itemconfigure $id -text [Widget::cget $path.f$page -text]
528	# Get the bbox for this text to determine its width, then substract
529	# 6 from the width to account for canvas bbox oddness w.r.t. widths of
530	# simple text.
531	foreach {x1 y1 x2 y2} [$path.c bbox $id] break
532	set x2 [expr {$x2 - 6}]
533        set wtext [expr {$x2 - $x1 + 20}]
534        if { [set img [Widget::cget $path.f$page -image]] != "" } {
535            set wtext [expr {$wtext + [image width $img] + 4}]
536            set himg  [expr {[image height $img] + 6}]
537            if { $himg > $hmax } {
538                set hmax $himg
539            }
540        }
541        set  wmax  [expr {$wtext > $wmax ? $wtext : $wmax}]
542        incr wtot  $wtext
543        set  data($page,width) $wtext
544    }
545    if { [Widget::cget $path -homogeneous] } {
546        foreach page $data(pages) {
547            set data($page,width) $wmax
548        }
549        set wtot [expr {$wmax * [llength $data(pages)]}]
550    }
551    set data(hpage) $hmax
552    set data(wpage) $wtot
553}
554
555
556# ---------------------------------------------------------------------------
557#  Command NoteBook::_compute_height
558# ---------------------------------------------------------------------------
559proc NoteBook::_compute_height { path } {
560    variable $path
561    upvar 0  $path data
562
563    set font    [Widget::cget $path -font]
564    set pady0   [Widget::_get_padding $path -tabpady 0]
565    set pady1   [Widget::_get_padding $path -tabpady 1]
566    set metrics [font metrics $font -linespace]
567    set imgh    0
568    set lines   1
569    foreach page $data(pages) {
570        set img  [Widget::cget $path.f$page -image]
571        set text [Widget::cget $path.f$page -text]
572        set len [llength [split $text \n]]
573        if {$len > $lines} { set lines $len}
574        if {$img != ""} {
575            set h [image height $img]
576            if {$h > $imgh} { set imgh $h }
577        }
578    }
579    set height [expr {$metrics * $lines}]
580    if {$imgh > $height} { set height $imgh }
581    set data(hpage) [expr {$height + $pady0 + $pady1}]
582}
583
584
585# ---------------------------------------------------------------------------
586#  Command NoteBook::_get_x_page
587# ---------------------------------------------------------------------------
588proc NoteBook::_get_x_page { path pos } {
589    variable _warrow
590    variable $path
591    upvar 0  $path data
592
593    set base $data(base)
594    # notebook tabs start flush with the left side of the notebook
595    set x 0
596    if { $pos < $base } {
597        foreach page [lrange $data(pages) $pos [expr {$base-1}]] {
598            incr x [expr {-$data($page,width)}]
599        }
600    } elseif { $pos > $base } {
601        foreach page [lrange $data(pages) $base [expr {$pos-1}]] {
602            incr x $data($page,width)
603        }
604    }
605    return $x
606}
607
608
609# ---------------------------------------------------------------------------
610#  Command NoteBook::_xview
611# ---------------------------------------------------------------------------
612proc NoteBook::_xview { path inc } {
613    variable $path
614    upvar 0  $path data
615
616    if { $inc == -1 } {
617        set base [expr {$data(base)-1}]
618        set dx $data([lindex $data(pages) $base],width)
619    } else {
620        set dx [expr {-$data([lindex $data(pages) $data(base)],width)}]
621        set base [expr {$data(base)+1}]
622    }
623
624    if { $base >= 0 && $base < [llength $data(pages)] } {
625        set data(base) $base
626        $path.c move page $dx 0
627        _draw_area   $path
628        _draw_arrows $path
629    }
630}
631
632
633# ---------------------------------------------------------------------------
634#  Command NoteBook::_highlight
635# ---------------------------------------------------------------------------
636proc NoteBook::_highlight { type path page } {
637    variable $path
638    upvar 0  $path data
639
640    if { [string equal [Widget::cget $path.f$page -state] "disabled"] } {
641        return
642    }
643
644    switch -- $type {
645        on {
646            $path.c itemconfigure "$page:poly" \
647		    -fill [_getoption $path $page -activebackground]
648            $path.c itemconfigure "$page:text" \
649		    -fill [_getoption $path $page -activeforeground]
650        }
651        off {
652            $path.c itemconfigure "$page:poly" \
653		    -fill [_getoption $path $page -background]
654            $path.c itemconfigure "$page:text" \
655		    -fill [_getoption $path $page -foreground]
656        }
657    }
658}
659
660
661# ---------------------------------------------------------------------------
662#  Command NoteBook::_select
663# ---------------------------------------------------------------------------
664proc NoteBook::_select { path page } {
665    variable $path
666    upvar 0  $path data
667
668    if {![string equal [Widget::cget $path.f$page -state] "normal"]} { return }
669
670    set oldsel $data(select)
671
672    if {[string equal $page $oldsel]} { return }
673
674    if { ![string equal $oldsel ""] } {
675	set cmd [Widget::cget $path.f$oldsel -leavecmd]
676	if { ![string equal $cmd ""] } {
677	    set code [catch {uplevel \#0 $cmd} res]
678	    if { $code == 1 || $res == 0 } {
679		return -code $code $res
680	    }
681	}
682	set data(select) ""
683	_draw_page $path $oldsel 0
684    }
685
686    set data(select) $page
687    if { ![string equal $page ""] } {
688	if { !$data($page,realized) } {
689	    set data($page,realized) 1
690	    set cmd [Widget::cget $path.f$page -createcmd]
691	    if { ![string equal $cmd ""] } {
692		uplevel \#0 $cmd
693	    }
694	}
695	set cmd [Widget::cget $path.f$page -raisecmd]
696	if { ![string equal $cmd ""] } {
697	    uplevel \#0 $cmd
698	}
699	_draw_page $path $page 0
700    }
701
702    _draw_area $path
703}
704
705
706# -----------------------------------------------------------------------------
707#  Command NoteBook::_redraw
708# -----------------------------------------------------------------------------
709proc NoteBook::_redraw { path } {
710    variable $path
711    upvar 0  $path data
712
713    if { !$data(realized) } { return }
714
715    _compute_height $path
716
717    foreach page $data(pages) {
718        _draw_page $path $page 0
719    }
720    _draw_area   $path
721    _draw_arrows $path
722}
723
724
725# ----------------------------------------------------------------------------
726#  Command NoteBook::_draw_page
727# ----------------------------------------------------------------------------
728proc NoteBook::_draw_page { path page create } {
729    variable $path
730    upvar 0  $path data
731
732    # --- calcul des coordonnees et des couleurs de l'onglet ------------------
733    set pos [lsearch -exact $data(pages) $page]
734    set bg  [_getoption $path $page -background]
735
736    # lookup the tab colors
737    set fgt   $data(lbg)
738    set fgb   $data(dbg)
739
740    set h   $data(hpage)
741    set xd  [_get_x_page $path $pos]
742    set xf  [expr {$xd + $data($page,width)}]
743
744    # Set the initial text offsets -- a few pixels down, centered left-to-right
745    set textOffsetY [expr [Widget::_get_padding $path -tabpady 0] + 3]
746    set textOffsetX 9
747
748    # Coordinates of the tab corners are:
749    #     c3        c4
750    #
751    # c2                c5
752    #
753    # c1                c6
754    #
755    # where
756    # c1 = $xd,	  $h
757    # c2 = $xd+$xBevel,	           $arcRadius+2
758    # c3 = $xd+$xBevel+$arcRadius, $arcRadius
759    # c4 = $xf+1-$xBevel,          $arcRadius
760    # c5 = $xf+$arcRadius-$xBevel, $arcRadius+2
761    # c6 = $xf+$arcRadius,         $h
762
763    set top		2
764    set arcRadius	[Widget::cget $path -arcradius]
765    set xBevel		[Widget::cget $path -tabbevelsize]
766
767    if { $data(select) != $page } {
768	if { $pos == 0 } {
769	    # The leftmost page is a special case -- it is drawn with its
770	    # tab a little indented.  To achieve this, we incr xd.  We also
771	    # decr textOffsetX, so that the text doesn't move left/right.
772	    incr xd 2
773	    incr textOffsetX -2
774	}
775    } else {
776	# The selected page's text is raised higher than the others
777	incr top -2
778    }
779
780    # Precompute some coord values that we use a lot
781    set topPlusRadius	[expr {$top + $arcRadius}]
782    set rightPlusRadius	[expr {$xf + $arcRadius}]
783    set leftPlusRadius	[expr {$xd + $arcRadius}]
784
785    # Sven
786    set side [Widget::cget $path -side]
787    set tabsOnBottom [string equal $side "bottom"]
788
789    set h1 [expr {[winfo height $path]}]
790    set bd [Widget::cget $path -borderwidth]
791    if {$bd < 1} { set bd 1 }
792
793    if { $tabsOnBottom } {
794	set top [expr {$top * -1}]
795	set topPlusRadius [expr {$topPlusRadius * -1}]
796	# Hrm... the canvas has an issue with drawing diagonal segments
797	# of lines from the bottom to the top, so we have to draw this line
798	# backwards (ie, lt is actually the bottom, drawn from right to left)
799        set lt  [list \
800		$rightPlusRadius			[expr {$h1-$h-1}] \
801		[expr {$rightPlusRadius - $xBevel}]	[expr {$h1 + $topPlusRadius}] \
802		[expr {$xf - $xBevel}]			[expr {$h1 + $top}] \
803		[expr {$leftPlusRadius + $xBevel}]	[expr {$h1 + $top}] \
804		]
805        set lb  [list \
806		[expr {$leftPlusRadius + $xBevel}]	[expr {$h1 + $top}] \
807		[expr {$xd + $xBevel}]			[expr {$h1 + $topPlusRadius}] \
808		$xd					[expr {$h1-$h-1}] \
809		]
810	# Because we have to do this funky reverse order thing, we have to
811	# swap the top/bottom colors too.
812	set tmp $fgt
813	set fgt $fgb
814	set fgb $tmp
815    } else {
816	set lt [list \
817		$xd					$h \
818		[expr {$xd + $xBevel}]			$topPlusRadius \
819		[expr {$leftPlusRadius + $xBevel}]	$top \
820		[expr {$xf + 1 - $xBevel}]		$top \
821		]
822	set lb [list \
823		[expr {$xf + 1 - $xBevel}] 		[expr {$top + 1}] \
824		[expr {$rightPlusRadius - $xBevel}]	$topPlusRadius \
825		$rightPlusRadius			$h \
826		]
827    }
828
829    set img [Widget::cget $path.f$page -image]
830
831    set ytext $top
832    if { $tabsOnBottom } {
833	# The "+ 2" below moves the text closer to the bottom of the tab,
834	# so it doesn't look so cramped.  I should be able to achieve the
835	# same goal by changing the anchor of the text and using this formula:
836	# ytext = $top + $h1 - $textOffsetY
837	# but that doesn't quite work (I think the linespace from the text
838	# gets in the way)
839	incr ytext [expr {$h1 - $h + 2}]
840    }
841    incr ytext $textOffsetY
842
843    set xtext [expr {$xd + $textOffsetX}]
844    if { $img != "" } {
845	# if there's an image, put it on the left and move the text right
846	set ximg $xtext
847	incr xtext [expr {[image width $img] + 2}]
848    }
849
850    if { $data(select) == $page } {
851        set bd    [Widget::cget $path -borderwidth]
852	if {$bd < 1} { set bd 1 }
853        set fg    [_getoption $path $page -foreground]
854    } else {
855        set bd    1
856        if { [Widget::cget $path.f$page -state] == "normal" } {
857            set fg [_getoption $path $page -foreground]
858        } else {
859            set fg [_getoption $path $page -disabledforeground]
860        }
861    }
862
863    # --- creation ou modification de l'onglet --------------------------------
864    # Sven
865    if { $create } {
866	# Create the tab region
867        eval [list $path.c create polygon] [concat $lt $lb] [list \
868		-tags		[list page p:$page $page:poly] \
869		-outline	$bg \
870		-fill		$bg \
871		]
872        eval [list $path.c create line] $lt [list \
873            -tags [list page p:$page $page:top top] -fill $fgt -width $bd]
874        eval [list $path.c create line] $lb [list \
875            -tags [list page p:$page $page:bot bot] -fill $fgb -width $bd]
876        $path.c create text $xtext $ytext 			\
877		-text	[Widget::cget $path.f$page -text]	\
878		-font	[Widget::cget $path -font]		\
879		-fill	$fg					\
880		-anchor	nw					\
881		-tags	[list page p:$page $page:text]
882
883        $path.c bind p:$page <ButtonPress-1> \
884		[list NoteBook::_select $path $page]
885        $path.c bind p:$page <Enter> \
886		[list NoteBook::_highlight on  $path $page]
887        $path.c bind p:$page <Leave> \
888		[list NoteBook::_highlight off $path $page]
889    } else {
890        $path.c coords "$page:text" $xtext $ytext
891
892        $path.c itemconfigure "$page:text" \
893            -text [Widget::cget $path.f$page -text] \
894            -font [Widget::cget $path -font] \
895            -fill $fg
896    }
897    eval [list $path.c coords "$page:poly"] [concat $lt $lb]
898    eval [list $path.c coords "$page:top"]  $lt
899    eval [list $path.c coords "$page:bot"]  $lb
900    $path.c itemconfigure "$page:poly" -fill $bg  -outline $bg
901    $path.c itemconfigure "$page:top"  -fill $fgt -width $bd
902    $path.c itemconfigure "$page:bot"  -fill $fgb -width $bd
903
904    # Sven end
905
906    if { $img != "" } {
907        # Sven
908	set id [$path.c find withtag $page:img]
909	if { [string equal $id ""] } {
910	    set id [$path.c create image $ximg $ytext \
911		    -anchor nw    \
912		    -tags   [list page p:$page $page:img]]
913        }
914        $path.c coords $id $ximg $ytext
915        $path.c itemconfigure $id -image $img
916        # Sven end
917    } else {
918        $path.c delete $page:img
919    }
920
921    if { $data(select) == $page } {
922        $path.c raise p:$page
923    } elseif { $pos == 0 } {
924        if { $data(select) == "" } {
925            $path.c raise p:$page
926        } else {
927            $path.c lower p:$page p:$data(select)
928        }
929    } else {
930        set pred [lindex $data(pages) [expr {$pos-1}]]
931        if { $data(select) != $pred || $pos == 1 } {
932            $path.c lower p:$page p:$pred
933        } else {
934            $path.c lower p:$page p:[lindex $data(pages) [expr {$pos-2}]]
935        }
936    }
937}
938
939
940# -----------------------------------------------------------------------------
941#  Command NoteBook::_draw_arrows
942# -----------------------------------------------------------------------------
943proc NoteBook::_draw_arrows { path } {
944    variable _warrow
945    variable $path
946    upvar 0  $path data
947
948    set w       [expr {[winfo width $path]-1}]
949    set h       [expr {$data(hpage)-1}]
950    set nbpages [llength $data(pages)]
951    set xl      0
952    set xr      [expr {$w-$_warrow+1}]
953    # Sven
954    set side [Widget::cget $path -side]
955    if { [string equal $side "bottom"] } {
956        set h1 [expr {[winfo height $path]-1}]
957        set bd [Widget::cget $path -borderwidth]
958	if {$bd < 1} { set bd 1 }
959        set y0 [expr {$h1 - $data(hpage) + $bd}]
960    } else {
961        set y0 1
962    }
963    # Sven end (all y positions where replaced with $y0 later)
964
965    if { $data(base) > 0 } {
966        # Sven
967        if { ![llength [$path.c find withtag "leftarrow"]] } {
968            $path.c create window $xl $y0 \
969                -width  $_warrow            \
970                -height $h                  \
971                -anchor nw                  \
972                -window $path.c.fg            \
973                -tags   "leftarrow"
974        } else {
975            $path.c coords "leftarrow" $xl $y0
976            $path.c itemconfigure "leftarrow" -width $_warrow -height $h
977        }
978        # Sven end
979    } else {
980        $path.c delete "leftarrow"
981    }
982
983    if { $data(base) < $nbpages-1 &&
984         $data(wpage) + [_get_x_page $path 0] + 6 > $w } {
985        # Sven
986        if { ![llength [$path.c find withtag "rightarrow"]] } {
987            $path.c create window $xr $y0 \
988                -width  $_warrow            \
989                -height $h                  \
990                -window $path.c.fd            \
991                -anchor nw                  \
992                -tags   "rightarrow"
993        } else {
994            $path.c coords "rightarrow" $xr $y0
995            $path.c itemconfigure "rightarrow" -width $_warrow -height $h
996        }
997        # Sven end
998    } else {
999        $path.c delete "rightarrow"
1000    }
1001}
1002
1003
1004# -----------------------------------------------------------------------------
1005#  Command NoteBook::_draw_area
1006# -----------------------------------------------------------------------------
1007proc NoteBook::_draw_area { path } {
1008    variable $path
1009    upvar 0  $path data
1010
1011    set w   [expr {[winfo width  $path] - 1}]
1012    set h   [expr {[winfo height $path] - 1}]
1013    set bd  [Widget::cget $path -borderwidth]
1014    if {$bd < 1} { set bd 1 }
1015    set x0  [expr {$bd - 1}]
1016
1017    set arcRadius [Widget::cget $path -arcradius]
1018
1019    # Sven
1020    set side [Widget::cget $path -side]
1021    if {"$side" == "bottom"} {
1022        set y0 0
1023        set y1 [expr {$h - $data(hpage)}]
1024        set yo $y1
1025    } else {
1026        set y0 $data(hpage)
1027        set y1 $h
1028        set yo [expr {$h-$y0}]
1029    }
1030    # Sven end
1031    set dbg $data(dbg)
1032    set sel $data(select)
1033    if {  $sel == "" } {
1034        set xd  [expr {$w/2}]
1035        set xf  $xd
1036        set lbg $data(dbg)
1037    } else {
1038        set xd [_get_x_page $path [lsearch -exact $data(pages) $data(select)]]
1039        set xf [expr {$xd + $data($sel,width) + $arcRadius + 1}]
1040        set lbg $data(lbg)
1041    }
1042
1043    # Sven
1044    if { [llength [$path.c find withtag rect]] == 0} {
1045        $path.c create line $xd $y0 $x0 $y0 $x0 $y1 \
1046            -tags "rect toprect1"
1047        $path.c create line $w $y0 $xf $y0 \
1048            -tags "rect toprect2"
1049        $path.c create line 1 $h $w $h $w $y0 \
1050            -tags "rect botrect"
1051    }
1052    if {"$side" == "bottom"} {
1053        $path.c coords "toprect1" $w $y0 $x0 $y0 $x0 $y1
1054        $path.c coords "toprect2" $x0 $y1 $xd $y1
1055        $path.c coords "botrect"  $xf $y1 $w $y1 $w $y0
1056        $path.c itemconfigure "toprect1" -fill $lbg -width $bd
1057        $path.c itemconfigure "toprect2" -fill $dbg -width $bd
1058        $path.c itemconfigure "botrect" -fill $dbg -width $bd
1059    } else {
1060        $path.c coords "toprect1" $xd $y0 $x0 $y0 $x0 $y1
1061        $path.c coords "toprect2" $w $y0 $xf $y0
1062        $path.c coords "botrect"  $x0 $h $w $h $w $y0
1063        $path.c itemconfigure "toprect1" -fill $lbg -width $bd
1064        $path.c itemconfigure "toprect2" -fill $lbg -width $bd
1065        $path.c itemconfigure "botrect" -fill $dbg -width $bd
1066    }
1067    $path.c raise "rect"
1068    # Sven end
1069
1070    if { $sel != "" } {
1071        # Sven
1072        if { [llength [$path.c find withtag "window"]] == 0 } {
1073            $path.c create window 2 [expr {$y0+1}] \
1074                -width  [expr {$w-3}]           \
1075                -height [expr {$yo-3}]          \
1076                -anchor nw                      \
1077                -tags   "window"                \
1078                -window $path.f$sel
1079        }
1080        $path.c coords "window" 2 [expr {$y0+1}]
1081        $path.c itemconfigure "window"    \
1082            -width  [expr {$w-3}]           \
1083            -height [expr {$yo-3}]          \
1084            -window $path.f$sel
1085        # Sven end
1086    } else {
1087        $path.c delete "window"
1088    }
1089}
1090
1091
1092# -----------------------------------------------------------------------------
1093#  Command NoteBook::_resize
1094# -----------------------------------------------------------------------------
1095proc NoteBook::_resize { path } {
1096    variable $path
1097    upvar 0  $path data
1098
1099    if {!$data(realized)} {
1100	if { [set width  [Widget::cget $path -width]]  == 0 ||
1101	     [set height [Widget::cget $path -height]] == 0 } {
1102	    compute_size $path
1103	}
1104	set data(realized) 1
1105    }
1106
1107    NoteBook::_redraw $path
1108}
1109
1110
1111# Tree::_set_help --
1112#
1113#	Register dynamic help for a node in the tree.
1114#
1115# Arguments:
1116#	path		Tree to query
1117#	node		Node in the tree
1118#       force		Optional argument to force a reset of the help
1119#
1120# Results:
1121#	none
1122# Tree::_set_help --
1123#
1124#	Register dynamic help for a node in the tree.
1125#
1126# Arguments:
1127#	path		Tree to query
1128#	node		Node in the tree
1129#       force		Optional argument to force a reset of the help
1130#
1131# Results:
1132#	none
1133proc NoteBook::_set_help { path page } {
1134    Widget::getVariable $path help
1135
1136    set item $path.f$page
1137    set opts [list -helptype -helptext -helpvar]
1138    foreach {cty ctx cv} [eval [list Widget::hasChangedX $item] $opts] break
1139    set text [Widget::getoption $item -helptext]
1140
1141    ## If we've never set help for this item before, and text is not blank,
1142    ## we need to setup help.  We also need to reset help if any of the
1143    ## options have changed.
1144    if { (![info exists help($page)] && $text != "") || $cty || $ctx || $cv } {
1145	set help($page) 1
1146	set type [Widget::getoption $item -helptype]
1147        switch $type {
1148            balloon {
1149		DynamicHelp::register $path.c balloon p:$page $text
1150            }
1151            variable {
1152		set var [Widget::getoption $item -helpvar]
1153		DynamicHelp::register $path.c variable p:$page $var $text
1154            }
1155        }
1156    }
1157}
1158
1159
1160proc NoteBook::_get_page_name { path {item current} {tagindex end-1} } {
1161    return [string range [lindex [$path.c gettags $item] $tagindex] 2 end]
1162}
1163