source: trunk/BWidget-1.2.1/notebook.tcl @ 931

Last change on this file since 931 was 931, checked in by toby, 11 years ago

include rest of files

File size: 28.4 KB
Line 
1# ------------------------------------------------------------------------------
2#  notebook.tcl
3#  This file is part of Unifix BWidget Toolkit
4#  $Id: notebook.tcl,v 1.7 1999/07/09 11:49:18 eric 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#     - NoteBook::_realize
35# ------------------------------------------------------------------------------
36
37namespace eval NoteBook {
38    ArrowButton::use
39
40    namespace eval Page {
41        Widget::declare NoteBook::Page {
42            {-state      Enum       normal 0 {normal disabled}}
43            {-createcmd  String     ""     0}
44            {-raisecmd   String     ""     0}
45            {-leavecmd   String     ""     0}
46            {-image      TkResource ""     0 label}
47            {-text       String     ""     0}
48        }
49    }
50
51    Widget::declare NoteBook {
52        {-foreground         TkResource "" 0 button}
53        {-background         TkResource "" 0 button}
54        {-activebackground   TkResource "" 0 button}
55        {-activeforeground   TkResource "" 0 button}
56        {-disabledforeground TkResource "" 0 button}
57        {-font               TkResource "" 0 button}
58        {-side               Enum       top 1 {top bottom}}
59        {-homogeneous        Boolean 0   0}
60        {-borderwidth        Int 1   0 {=1 =2}}
61        {-width              Int 0   0 {=0 ""}}
62        {-height             Int 0   0 {=0 ""}}
63
64        {-repeatdelay        BwResource ""  0 ArrowButton}
65        {-repeatinterval     BwResource ""  0 ArrowButton}
66
67        {-fg                 Synonym -foreground}
68        {-bg                 Synonym -background}
69        {-bd                 Synonym -borderwidth}
70    }
71
72    Widget::addmap NoteBook "" :cmd {-background {}}
73    Widget::addmap NoteBook ArrowButton .fg \
74        {-foreground {} -background {} -activeforeground {} -activebackground {} \
75             -borderwidth {} -repeatinterval {} -repeatdelay {} -disabledforeground {}}
76    Widget::addmap NoteBook ArrowButton .fd \
77        {-foreground {} -background {} -activeforeground {} -activebackground {} \
78             -borderwidth {} -repeatinterval {} -repeatdelay {} -disabledforeground {}}
79
80    variable _warrow 12
81
82    proc ::NoteBook { path args } { return [eval NoteBook::create $path $args] }
83    proc use {} {}
84}
85
86
87# ------------------------------------------------------------------------------
88#  Command NoteBook::create
89# ------------------------------------------------------------------------------
90proc NoteBook::create { path args } {
91    variable $path
92    upvar 0  $path data
93
94    Widget::init NoteBook $path $args
95
96    set data(base)     0
97    set data(select)   ""
98    set data(pages)    {}
99    set data(pages)    {}
100    set data(cpt)      0
101    set data(realized) 0
102    set data(wpage)    0
103    set data(hpage)    [expr {[font metrics [Widget::getoption $path -font] -linespace] + 6}]
104    set bg             [Widget::getoption $path -background]
105
106    # --- creation du canvas -----------------------------------------------------------------
107    set w [expr {[Widget::getoption $path -width]+4}]
108    set h [expr {[Widget::getoption $path -height]+$data(hpage)+4}]
109    canvas $path -relief flat -bd 0 -highlightthickness 0 -bg $bg -width $w -height $h
110
111    # --- creation des arrow -----------------------------------------------------------------
112    eval ArrowButton::create $path.fg [Widget::subcget $path .fg] \
113        -highlightthickness 0 \
114        -type button  -dir left \
115        -armcommand [list "NoteBook::_xview $path -1"]
116
117    eval ArrowButton::create $path.fd [Widget::subcget $path .fd] \
118        -highlightthickness 0 \
119        -type button  -dir right \
120        -armcommand [list "NoteBook::_xview $path 1"]
121
122    set col       [BWidget::get3dcolor $path $bg]
123    set data(dbg) [lindex $col 0]
124    set data(lbg) [lindex $col 1]
125
126    bind $path <Configure> "NoteBook::_realize $path"
127    bind $path <Destroy>   "NoteBook::_destroy $path"
128
129    rename $path ::$path:cmd
130    proc ::$path { cmd args } "return \[eval NoteBook::\$cmd $path \$args\]"
131
132    return $path
133}
134
135
136# ------------------------------------------------------------------------------
137#  Command NoteBook::configure
138# ------------------------------------------------------------------------------
139proc NoteBook::configure { path args } {
140    variable $path
141    upvar 0  $path data
142
143    set res [Widget::configure $path $args]
144    set redraw 0
145    if { [set chf [Widget::hasChanged $path -font font]] ||
146         [Widget::hasChanged $path -homogeneous foo] } {
147        if { $chf } {
148            set data(hpage) [expr {[font metrics $font -linespace] + 6}]
149        }
150        _compute_width $path
151        set redraw 1
152    }
153    if { [Widget::hasChanged $path -background bg] } {
154        set col [BWidget::get3dcolor $path $bg]
155        set data(dbg)  [lindex $col 0]
156        set data(lbg)  [lindex $col 1]
157        set redraw 1
158    }
159    if { [Widget::hasChanged $path -foreground  fg] ||
160         [Widget::hasChanged $path -borderwidth bd] } {
161        set redraw 1
162    }
163    set wc [Widget::hasChanged $path -width  w]
164    set hc [Widget::hasChanged $path -height h]
165    if { $wc || $hc } {
166        $path:cmd configure -width [expr {$w+4}] -height [expr {$h + $data(hpage)+4}]
167    } elseif { $redraw } {
168        _redraw $path
169    }
170
171    return $res
172}
173
174
175# ------------------------------------------------------------------------------
176#  Command NoteBook::cget
177# ------------------------------------------------------------------------------
178proc NoteBook::cget { path option } {
179    return [Widget::cget $path $option]
180}
181
182
183# ------------------------------------------------------------------------------
184#  Command NoteBook::compute_size
185# ------------------------------------------------------------------------------
186proc NoteBook::compute_size { path } {
187    variable $path
188    upvar 0  $path data
189
190    set wmax 0
191    set hmax 0
192    update idletasks
193    foreach page $data(pages) {
194        set w    [winfo reqwidth  $path.f$page]
195        set h    [winfo reqheight $path.f$page]
196        set wmax [expr {$w>$wmax ? $w : $wmax}]
197        set hmax [expr {$h>$hmax ? $h : $hmax}]
198    }
199    configure $path -width $wmax -height $hmax
200}
201
202
203# ------------------------------------------------------------------------------
204#  Command NoteBook::insert
205# ------------------------------------------------------------------------------
206proc NoteBook::insert { path index page args } {
207    variable $path
208    upvar 0  $path data
209
210    if { [lsearch $data(pages) $page] != -1 } {
211        return -code error "page \"$page\" already exists"
212    }
213
214    Widget::init NoteBook::Page $path.f$page $args
215
216    set data(pages) [linsert $data(pages) $index $page]
217    if { ![winfo exists $path.f$page] } {
218        frame $path.f$page \
219            -relief flat -background [Widget::getoption $path -background] -borderwidth 10
220        set data($page,realized) 0
221    }
222    _compute_width $path
223    _draw_page $path $page 1
224    _redraw $path
225
226    return $path.f$page
227}
228
229
230# ------------------------------------------------------------------------------
231#  Command NoteBook::delete
232# ------------------------------------------------------------------------------
233proc NoteBook::delete { path page {destroyframe 1} } {
234    variable $path
235    upvar 0  $path data
236
237    set pos [_test_page $path $page]
238    set data(pages) [lreplace $data(pages) $pos $pos]
239    _compute_width $path
240    $path:cmd delete p:$page
241    if { $data(select) == $page } {
242        set data(select) ""
243    }
244    if { $pos < $data(base) } {
245        incr data(base) -1
246    }
247    if { $destroyframe } {
248        destroy $path.f$page
249    }
250    _redraw $path
251}
252
253
254# ------------------------------------------------------------------------------
255#  Command NoteBook::itemconfigure
256# ------------------------------------------------------------------------------
257proc NoteBook::itemconfigure { path page args } {
258    _test_page $path $page
259    set res [_itemconfigure $path $page $args]
260    _redraw $path
261
262    return $res
263}
264
265
266# ------------------------------------------------------------------------------
267#  Command NoteBook::itemcget
268# ------------------------------------------------------------------------------
269proc NoteBook::itemcget { path page option } {
270    _test_page $path $page
271    return [Widget::cget $path.f$page $option]
272}
273
274
275# ------------------------------------------------------------------------------
276#  Command NoteBook::bindtabs
277# ------------------------------------------------------------------------------
278proc NoteBook::bindtabs { path event script } {
279    if { $script != "" } {
280        $path:cmd bind "page" $event \
281            "$script \[string range \[lindex \[$path:cmd gettags current\] 1\] 2 end\]"
282    } else {
283        $path:cmd bind "page" $event {}
284    }
285}
286
287
288# ------------------------------------------------------------------------------
289#  Command NoteBook::move
290# ------------------------------------------------------------------------------
291proc NoteBook::move { path page index } {
292    variable $path
293    upvar 0  $path data
294
295    set pos [_test_page $path $page]
296    set data(pages) [linsert [lreplace $data(pages) $pos $pos] $index $page]
297    _redraw $path
298}
299
300
301# ------------------------------------------------------------------------------
302#  Command NoteBook::raise
303# ------------------------------------------------------------------------------
304proc NoteBook::raise { path {page ""} } {
305    variable $path
306    upvar 0  $path data
307
308    if { $page != "" } {
309        _test_page $path $page
310        _select $path $page
311    }
312    return $data(select)
313}
314
315
316# ------------------------------------------------------------------------------
317#  Command NoteBook::see
318# ------------------------------------------------------------------------------
319proc NoteBook::see { path page } {
320    variable $path
321    upvar 0  $path data
322
323    set pos [_test_page $path $page]
324    if { $pos < $data(base) } {
325        set data(base) $pos
326        _redraw $path
327    } else {
328        set w     [expr {[winfo width $path]-1}]
329        set fpage [expr {[_get_x_page $path $pos] + $data($page,width) + 6}]
330        set idx   $data(base)
331        while { $idx < $pos && $fpage > $w } {
332            set fpage [expr {$fpage - $data([lindex $data(pages) $idx],width)}]
333            incr idx
334        }
335        if { $idx != $data(base) } {
336            set data(base) $idx
337            _redraw $path
338        }
339    }
340}
341
342
343# ------------------------------------------------------------------------------
344#  Command NoteBook::page
345# ------------------------------------------------------------------------------
346proc NoteBook::page { path first {last ""} } {
347    variable $path
348    upvar 0  $path data
349
350    if { $last == "" } {
351        return [lindex $data(pages) $first]
352    } else {
353        return [lrange $data(pages) $first $last]
354    }
355}
356
357
358# ------------------------------------------------------------------------------
359#  Command NoteBook::pages
360# ------------------------------------------------------------------------------
361proc NoteBook::pages { path {first ""} {last ""}} {
362    variable $path
363    upvar 0  $path data
364
365    if { ![string length $first] } {
366        return $data(pages)
367    }
368
369    if { ![string length $last] } {
370        return [lindex $data(pages) $first]
371    } else {
372        return [lrange $data(pages) $first $last]
373    }
374}
375
376
377# ------------------------------------------------------------------------------
378#  Command NoteBook::index
379# ------------------------------------------------------------------------------
380proc NoteBook::index { path page } {
381    variable $path
382    upvar 0  $path data
383
384    return [lsearch $data(pages) $page]
385}
386
387
388# ------------------------------------------------------------------------------
389#  Command NoteBook::_destroy
390# ------------------------------------------------------------------------------
391proc NoteBook::_destroy { path } {
392    variable $path
393    upvar 0  $path data
394
395    foreach page $data(pages) {
396        Widget::destroy $path.f$page
397    }
398    Widget::destroy $path
399    unset data
400    rename $path {}
401}
402
403
404# ------------------------------------------------------------------------------
405#  Command NoteBook::getframe
406# ------------------------------------------------------------------------------
407proc NoteBook::getframe { path page } {
408    return $path.f$page
409}
410
411
412# ------------------------------------------------------------------------------
413#  Command NoteBook::_test_page
414# ------------------------------------------------------------------------------
415proc NoteBook::_test_page { path page } {
416    variable $path
417    upvar 0  $path data
418
419    if { [set pos [lsearch $data(pages) $page]] == -1 } {
420        return -code error "page \"$page\" does not exists"
421    }
422    return $pos
423}
424
425
426# ------------------------------------------------------------------------------
427#  Command NoteBook::_itemconfigure
428# ------------------------------------------------------------------------------
429proc NoteBook::_itemconfigure { path page lres } {
430    variable $path
431    upvar 0  $path data
432
433    set res [Widget::configure $path.f$page $lres]
434    if { [Widget::hasChanged $path.f$page -text foo] } {
435        _compute_width $path
436    } elseif  { [Widget::hasChanged $path.f$page -image foo] } {
437        set data(hpage) [expr {[font metrics [Widget::getoption $path -font] -linespace] + 6}]
438        _compute_width $path
439    }
440    if { [Widget::hasChanged $path.f$page -state state] &&
441         $state == "disabled" && $data(select) == $page } {
442        set data(select) ""
443    }
444    return $res
445}
446
447
448# ------------------------------------------------------------------------------
449#  Command NoteBook::_compute_width
450# ------------------------------------------------------------------------------
451proc NoteBook::_compute_width { path } {
452    variable $path
453    upvar 0  $path data
454
455    set font [Widget::getoption $path -font]
456    set wmax 0
457    set hmax $data(hpage)
458    set wtot 0
459    if { ![info exists data(textid)] } {
460        set data(textid) [$path:cmd create text 0 -100 -font [Widget::getoption $path -font] -anchor nw]
461    }
462    set id $data(textid)
463    $path:cmd itemconfigure $id -font [Widget::getoption $path -font]
464    foreach page $data(pages) {
465        $path:cmd itemconfigure $id -text [Widget::getoption $path.f$page -text]
466        set  wtext [expr {[lindex [$path:cmd bbox $id] 2]+20}]
467        if { [set img [Widget::getoption $path.f$page -image]] != "" } {
468            set wtext [expr {$wtext+[image width $img]+4}]
469            set himg  [expr {[image height $img]+6}]
470            if { $himg > $hmax } {
471                set hmax $himg
472            }
473        }
474        set  wmax  [expr {$wtext>$wmax ? $wtext : $wmax}]
475        incr wtot  $wtext
476        set  data($page,width) $wtext
477    }
478    if { [Widget::getoption $path -homogeneous] } {
479        foreach page $data(pages) {
480            set data($page,width) $wmax
481        }
482        set wtot [expr {$wmax * [llength $data(pages)]}]
483    }
484    set data(hpage) $hmax
485    set data(wpage) $wtot
486}
487
488
489# ------------------------------------------------------------------------------
490#  Command NoteBook::_get_x_page
491# ------------------------------------------------------------------------------
492proc NoteBook::_get_x_page { path pos } {
493    variable _warrow
494    variable $path
495    upvar 0  $path data
496
497    set base $data(base)
498    set x    [expr {$_warrow+1}]
499    if { $pos < $base } {
500        foreach page [lrange $data(pages) $pos [expr {$base-1}]] {
501            incr x [expr {-$data($page,width)}]
502        }
503    } elseif { $pos > $base } {
504        foreach page [lrange $data(pages) $base [expr {$pos-1}]] {
505            incr x $data($page,width)
506        }
507    }
508    return $x
509}
510
511
512# ------------------------------------------------------------------------------
513#  Command NoteBook::_xview
514# ------------------------------------------------------------------------------
515proc NoteBook::_xview { path inc } {
516    variable $path
517    upvar 0  $path data
518
519    if { $inc == -1 } {
520        set base [expr {$data(base)-1}]
521        set dx $data([lindex $data(pages) $base],width)
522    } else {
523        set dx [expr {-$data([lindex $data(pages) $data(base)],width)}]
524        set base [expr {$data(base)+1}]
525    }
526
527    if { $base >= 0 && $base < [llength $data(pages)] } {
528        set data(base) $base
529        $path:cmd move page $dx 0
530        _draw_area   $path
531        _draw_arrows $path
532    }
533}
534
535
536# ------------------------------------------------------------------------------
537#  Command NoteBook::_highlight
538# ------------------------------------------------------------------------------
539proc NoteBook::_highlight { type path page } {
540    variable $path
541    upvar 0  $path data
542
543    if { ![string compare [Widget::getoption $path.f$page -state] "disabled"] } {
544        return
545    }
546
547    switch -- $type {
548        on {
549            $path:cmd itemconfigure "$page:poly" -fill [Widget::getoption $path -activebackground]
550            $path:cmd itemconfigure "$page:text" -fill [Widget::getoption $path -activeforeground]
551        }
552        off {
553            $path:cmd itemconfigure "$page:poly" -fill [Widget::getoption $path -background]
554            $path:cmd itemconfigure "$page:text" -fill [Widget::getoption $path -foreground]
555        }
556    }
557}
558
559
560# ------------------------------------------------------------------------------
561#  Command NoteBook::_select
562# ------------------------------------------------------------------------------
563proc NoteBook::_select { path page } {
564    variable $path
565    upvar 0  $path data
566
567    if { ![string compare [Widget::getoption $path.f$page -state] "normal"] } {
568        set oldsel $data(select)
569        if { [string compare $page $oldsel] } {
570            if { $oldsel != "" } {
571                if { [set cmd [Widget::getoption $path.f$oldsel -leavecmd]] != "" } {
572                    if { [set code [catch {uplevel \#0 $cmd} res]] == 1 || $res == 0 } {
573                        return -code $code $res
574                    }
575                }
576                set data(select) ""
577                _draw_page $path $oldsel 0
578            }
579            set data(select) $page
580            if { $page != "" } {
581                if { !$data($page,realized) } {
582                    set data($page,realized) 1
583                    if { [set cmd [Widget::getoption $path.f$page -createcmd]] != "" } {
584                        uplevel \#0 $cmd
585                    }
586                }
587                if { [set cmd [Widget::getoption $path.f$page -raisecmd]] != "" } {
588                    uplevel \#0 $cmd
589                }
590                _draw_page $path $page 0
591            }
592            _draw_area $path
593        }
594    }
595}
596
597
598# ------------------------------------------------------------------------------
599#  Command NoteBook::_redraw
600# ------------------------------------------------------------------------------
601proc NoteBook::_redraw { path } {
602    variable $path
603    upvar 0  $path data
604
605    if { !$data(realized) } {
606        return
607    }
608
609    foreach page $data(pages) {
610        _draw_page $path $page 0
611    }
612    _draw_area   $path
613    _draw_arrows $path
614}
615
616
617# ------------------------------------------------------------------------------
618#  Command NoteBook::_draw_page
619# ------------------------------------------------------------------------------
620proc NoteBook::_draw_page { path page create } {
621    variable $path
622    upvar 0  $path data
623
624    # --- calcul des coordonnees et des couleurs de l'onglet ---------------------------------
625    set pos [lsearch $data(pages) $page]
626    set bg  [Widget::getoption $path -background]
627    set h   $data(hpage)
628    set xd  [_get_x_page $path $pos]
629    set xf  [expr {$xd + $data($page,width)}]
630    set lt  [list $xd $h $xd 4 [expr {$xd+3}] 1 $xf 1]
631    set lb  [list $xf 1 [expr {$xf+3}] 4 [expr {$xf+3}] [expr {$h-3}] [expr {$xf+6}] $h]
632    set img [Widget::getoption $path.f$page -image]
633    if { $data(select) == $page } {
634        set fgt   $data(lbg)
635        set fgb   $data(dbg)
636        set ytext [expr {$h/2-1}]
637        if { $img == "" } {
638            set xtext [expr {$xd+9}]
639        } else {
640            set ximg  [expr {$xd+9}]
641            set xtext [expr {$ximg+[image width $img]+4}]
642        }
643        set bd    [Widget::getoption $path -borderwidth]
644        set fg    [Widget::getoption $path -foreground]
645    } else {
646        set fgt   $data(dbg)
647        set fgb   $fgt
648        set ytext [expr {$h/2}]
649        if { $img == "" } {
650            set xtext [expr {$xd+10}]
651        } else {
652            set ximg  [expr {$xd+10}]
653            set xtext [expr {$ximg+[image width $img]+4}]
654        }
655        set bd    1
656        if { [Widget::getoption $path.f$page -state] == "normal" } {
657            set fg [Widget::getoption $path -foreground]
658        } else {
659            set fg [Widget::getoption $path -disabledforeground]
660        }
661    }
662
663    # --- creation ou modification de l'onglet -----------------------------------------------
664    if { $create } {
665        eval $path:cmd create polygon [concat $lt $lb] \
666            -tag     {"page p:$page $page:poly"} \
667            -outline $bg \
668            -fill    $bg
669        eval $path:cmd create line $lt -tags {"page p:$page $page:top top"} -fill $fgt -width $bd
670        eval $path:cmd create line $lb -tags {"page p:$page $page:bot bot"} -fill $fgb -width $bd
671        $path:cmd create text $xtext $ytext           \
672            -text   [Widget::getoption $path.f$page -text] \
673            -font   [Widget::getoption $path -font]        \
674            -fill   $fg                               \
675            -anchor w                                 \
676            -tags   "page p:$page $page:text"
677
678        $path:cmd bind p:$page <ButtonPress-1> "NoteBook::_select $path $page"
679        $path:cmd bind p:$page <Enter>         "NoteBook::_highlight on  $path $page"
680        $path:cmd bind p:$page <Leave>         "NoteBook::_highlight off $path $page"
681    } else {
682        eval $path:cmd coords "$page:poly" [concat $lt $lb]
683        eval $path:cmd coords "$page:top"  $lt
684        eval $path:cmd coords "$page:bot"  $lb
685        $path:cmd coords "$page:text" $xtext $ytext
686
687        $path:cmd itemconfigure "$page:poly" -fill $bg  -outline $bg
688        $path:cmd itemconfigure "$page:top"  -fill $fgt -width $bd
689        $path:cmd itemconfigure "$page:bot"  -fill $fgb -width $bd
690        $path:cmd itemconfigure "$page:text"    \
691            -text [Widget::getoption $path.f$page -text]     \
692            -font [Widget::getoption $path -font]    \
693            -fill $fg
694    }
695    if { $img != "" } {
696        if { [set id [$path:cmd find withtag $page:img]] == "" } {
697            $path:cmd create image $ximg $ytext \
698                -image  $img \
699                -anchor w    \
700                -tags   "page p:$page $page:img"
701        } else {
702            $path:cmd coords $id $ximg $ytext
703            $path:cmd itemconfigure $id -image $img
704        }
705    } else {
706        $path:cmd delete $page:img
707    }
708
709    if { $data(select) == $page } {
710        $path:cmd raise p:$page
711    } elseif { $pos == 0 } {
712        if { $data(select) == "" } {
713            $path:cmd raise p:$page
714        } else {
715            $path:cmd lower p:$page p:$data(select)
716        }
717    } else {
718        set pred [lindex $data(pages) [expr {$pos-1}]]
719        if { $data(select) != $pred || $pos == 1 } {
720            $path:cmd lower p:$page p:$pred
721        } else {
722            $path:cmd lower p:$page p:[lindex $data(pages) [expr {$pos-2}]]
723        }
724    }
725}
726
727
728# ------------------------------------------------------------------------------
729#  Command NoteBook::_draw_arrows
730# ------------------------------------------------------------------------------
731proc NoteBook::_draw_arrows { path } {
732    variable _warrow
733    variable $path
734    upvar 0  $path data
735
736    set w       [expr {[winfo width $path]-1}]
737    set h       [expr {$data(hpage)-1}]
738    set nbpages [llength $data(pages)]
739    set xl      0
740    set xr      [expr {$w-$_warrow+1}]
741
742    if { $data(base) > 0 } {
743        if { ![llength [$path:cmd find withtag "leftarrow"]] } {
744            $path:cmd create window $xl 1 \
745                -width  $_warrow          \
746                -height $h                \
747                -anchor nw                \
748                -window $path.fg          \
749                -tags   "leftarrow"
750        } else {
751            $path:cmd coords "leftarrow" $xl 1
752            $path:cmd itemconfigure "leftarrow" -width $_warrow -height $h
753        }
754    } else {
755        $path:cmd delete "leftarrow"
756    }
757
758    if { $data(base) < $nbpages-1 &&
759         $data(wpage) + [_get_x_page $path 0] + 6 > $w } {
760        if { ![llength [$path:cmd find withtag "rightarrow"]] } {
761            $path:cmd create window $xr 1 \
762                -width  $_warrow          \
763                -height $h                \
764                -window $path.fd          \
765                -anchor nw                \
766                -tags   "rightarrow"
767        } else {
768            $path:cmd coords "rightarrow" $xr 1
769            $path:cmd itemconfigure "rightarrow" -width $_warrow -height $h
770        }
771    } else {
772        $path:cmd delete "rightarrow"
773    }
774}
775
776
777# ------------------------------------------------------------------------------
778#  Command NoteBook::_draw_area
779# ------------------------------------------------------------------------------
780proc NoteBook::_draw_area { path } {
781    variable $path
782    upvar 0  $path data
783
784    set w   [expr {[winfo width  $path]-1}]
785    set h   [expr {[winfo height $path]-1}]
786    set bd  [Widget::getoption $path -borderwidth]
787    set x0  [expr {$bd-1}]
788    set y0  $data(hpage)
789    set y1  $h
790    set dbg $data(dbg)
791    set sel $data(select)
792    if {  $sel == "" } {
793        set xd  [expr {$w/2}]
794        set xf  $xd
795        set lbg $data(dbg)
796    } else {
797        set xd [_get_x_page $path [lsearch $data(pages) $data(select)]]
798        set xf [expr {$xd + $data($sel,width)+6}]
799        set lbg $data(lbg)
800    }
801
802    if { [llength [$path:cmd find withtag rect]] } {
803        $path:cmd coords "toprect1" $xd $y0 $x0 $y0 $x0 $h
804        $path:cmd coords "toprect2" $w $y0 $xf $y0
805        $path:cmd coords "botrect"  $x0 $h $w $h $w $y0
806        $path:cmd itemconfigure "toprect1" -fill $lbg -width $bd
807        $path:cmd itemconfigure "toprect2" -fill $lbg -width $bd
808        $path:cmd itemconfigure "botrect"  -width $bd
809        $path:cmd raise "rect"
810    } else {
811        $path:cmd create line $xd $y0 $x0 $y0 $x0 $y1 \
812            -tags "rect toprect1" -fill $lbg -width $bd
813        $path:cmd create line $w $y0 $xf $y0 \
814            -tags "rect toprect2" -fill $lbg -width $bd
815        $path:cmd create line 1 $h $w $h $w $y0 \
816            -tags "rect botrect"  -fill $dbg -width $bd
817    }
818
819    if { $sel != "" } {
820        if { [llength [$path:cmd find withtag "window"]] } {
821            $path:cmd coords "window" 2 [expr {$y0+1}]
822            $path:cmd itemconfigure "window"    \
823                -width  [expr {$w-3}]        \
824                -height [expr {$h-$y0-3}]    \
825                -window $path.f$sel
826        } else {
827            set y0 $data(hpage)
828            $path:cmd create window 2 [expr {$y0+1}] \
829                -width  [expr {$w-3}]           \
830                -height [expr {$h-$y0-3}]       \
831                -anchor nw                      \
832                -tags   "window"                \
833                -window $path.f$sel
834        }
835    } else {
836        $path:cmd delete "window"
837    }
838}
839
840
841# ------------------------------------------------------------------------------
842#  Command NoteBook::_resize
843# ------------------------------------------------------------------------------
844proc NoteBook::_resize { path } {
845    _draw_area   $path
846    _draw_arrows $path
847}
848
849
850# ------------------------------------------------------------------------------
851#  Command NoteBook::_realize
852# ------------------------------------------------------------------------------
853proc NoteBook::_realize { path } {
854    variable $path
855    upvar 0  $path data
856
857    if { [set width  [Widget::getoption $path -width]]  == 0 ||
858         [set height [Widget::getoption $path -height]] == 0 } {
859        compute_size $path
860    }
861
862    set data(realized) 1
863    _draw_area $path
864    _draw_arrows $path
865    bind $path <Configure> "NoteBook::_resize $path"
866}
Note: See TracBrowser for help on using the repository browser.