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