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