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