1# --------------------------------------------------------------------------- 2# notebook.tcl 3# This file is part of Unifix BWidget Toolkit 4# $Id: notebook.tcl,v 1.16 2003/05/15 00:09:03 hobbs 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 {-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 0 {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 {-arcradius Int 2 0 "%d >= 0 && %d <= 8"} 90 {-tabbevelsize Int 0 0 "%d >= 0 && %d <= 8"} 91 } 92 93 Widget::addmap NoteBook "" .c {-background {}} 94 95 variable _warrow 12 96 97 proc ::NoteBook { path args } { return [eval NoteBook::create $path $args] } 98 proc use {} {} 99} 100 101 102# --------------------------------------------------------------------------- 103# Command NoteBook::create 104# --------------------------------------------------------------------------- 105proc 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 [list canvas $path.c] [Widget::subcget $path .c] \ 128 [list -relief flat -borderwidth 0 -highlightthickness 0 \ 129 -width $w -height $h] 130 pack $path.c -expand yes -fill both 131 132 # Removing the Canvas global bindings from our canvas as 133 # application specific bindings on that tag may interfere with its 134 # operation here. [SF item #459033] 135 136 set bindings [bindtags $path.c] 137 set pos [lsearch -exact $bindings Canvas] 138 if {$pos >= 0} { 139 set bindings [lreplace $bindings $pos $pos] 140 } 141 bindtags $path.c $bindings 142 143 # Create the arrow button 144 eval [list ArrowButton::create $path.c.fg] [Widget::subcget $path .c.fg] \ 145 [list -highlightthickness 0 -type button -dir left \ 146 -armcommand [list NoteBook::_xview $path -1]] 147 148 eval [list ArrowButton::create $path.c.fd] [Widget::subcget $path .c.fd] \ 149 [list -highlightthickness 0 -type button -dir right \ 150 -armcommand [list NoteBook::_xview $path 1]] 151 152 bind $path <Configure> [list NoteBook::_realize $path] 153 bind $path <Destroy> [list NoteBook::_destroy $path] 154 155 rename $path ::$path:cmd 156 proc ::$path { cmd args } "return \[eval NoteBook::\$cmd [list $path] \$args\]" 157 158 set bg [Widget::cget $path -background] 159 foreach {data(dbg) data(lbg)} [BWidget::get3dcolor $path $bg] {break} 160 161 return $path 162} 163 164 165# --------------------------------------------------------------------------- 166# Command NoteBook::configure 167# --------------------------------------------------------------------------- 168proc NoteBook::configure { path args } { 169 variable $path 170 upvar 0 $path data 171 172 set res [Widget::configure $path $args] 173 set redraw 0 174 if { [set chf [Widget::hasChanged $path -font font]] || 175 [Widget::hasChanged $path -homogeneous foo] } { 176 if { $chf } { 177 set data(hpage) [expr {[font metrics $font -linespace] + 6}] 178 } 179 _compute_width $path 180 set redraw 1 181 } 182 set chibd [Widget::hasChanged $path -internalborderwidth ibd] 183 set chbg [Widget::hasChanged $path -background bg] 184 if {$chibd || $chbg} { 185 foreach page $data(pages) { 186 $path.f$page configure \ 187 -borderwidth $ibd -background $bg 188 } 189 } 190 191 if {$chbg} { 192 set col [BWidget::get3dcolor $path $bg] 193 set data(dbg) [lindex $col 0] 194 set data(lbg) [lindex $col 1] 195 set redraw 1 196 } 197 if { [Widget::hasChanged $path -foreground fg] || 198 [Widget::hasChanged $path -borderwidth bd] || 199 [Widget::hasChanged $path -arcradius radius] || 200 [Widget::hasChanged $path -tabbevelsize bevel] || 201 [Widget::hasChanged $path -side side] } { 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# --------------------------------------------------------------------------- 222proc NoteBook::cget { path option } { 223 return [Widget::cget $path $option] 224} 225 226 227# --------------------------------------------------------------------------- 228# Command NoteBook::compute_size 229# --------------------------------------------------------------------------- 230proc 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# --------------------------------------------------------------------------- 253proc 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# --------------------------------------------------------------------------- 287proc 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# --------------------------------------------------------------------------- 311proc 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# --------------------------------------------------------------------------- 323proc 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# --------------------------------------------------------------------------- 332proc 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# --------------------------------------------------------------------------- 345proc 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# --------------------------------------------------------------------------- 358proc 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# --------------------------------------------------------------------------- 373proc 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# --------------------------------------------------------------------------- 400proc 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# --------------------------------------------------------------------------- 415proc 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# --------------------------------------------------------------------------- 434proc 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# --------------------------------------------------------------------------- 445proc 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# --------------------------------------------------------------------------- 461proc NoteBook::getframe { path page } { 462 return $path.f$page 463} 464 465 466# --------------------------------------------------------------------------- 467# Command NoteBook::_test_page 468# --------------------------------------------------------------------------- 469proc 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 479proc 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# --------------------------------------------------------------------------- 490proc 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# --------------------------------------------------------------------------- 512proc 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# --------------------------------------------------------------------------- 558proc 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# --------------------------------------------------------------------------- 582proc 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# --------------------------------------------------------------------------- 606proc 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# --------------------------------------------------------------------------- 634proc 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# ----------------------------------------------------------------------------- 676proc 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# ---------------------------------------------------------------------------- 695proc 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+$xBevel, $arcRadius+2 725 # c3 = $xd+$xBevel+$arcRadius, $arcRadius 726 # c4 = $xf+1-$xBevel, $arcRadius 727 # c5 = $xf+$arcRadius-$xBevel, $arcRadius+2 728 # c6 = $xf+$arcRadius, $h 729 730 set top 2 731 set arcRadius [Widget::cget $path -arcradius] 732 set xBevel [Widget::cget $path -tabbevelsize] 733 734 if { $data(select) != $page } { 735 if { $pos == 0 } { 736 # The leftmost page is a special case -- it is drawn with its 737 # tab a little indented. To achieve this, we incr xd. We also 738 # decr textOffsetX, so that the text doesn't move left/right. 739 incr xd 2 740 incr textOffsetX -2 741 } 742 } else { 743 # The selected page's text is raised higher than the others 744 incr top -2 745 } 746 747 # Precompute some coord values that we use a lot 748 set topPlusRadius [expr {$top + $arcRadius}] 749 set rightPlusRadius [expr {$xf + $arcRadius}] 750 set leftPlusRadius [expr {$xd + $arcRadius}] 751 752 # Sven 753 set side [Widget::cget $path -side] 754 set tabsOnBottom [string equal $side "bottom"] 755 756 set h1 [expr {[winfo height $path]}] 757 set bd [Widget::cget $path -borderwidth] 758 if {$bd < 1} { set bd 1 } 759 760 if { $tabsOnBottom } { 761 set top [expr {$top * -1}] 762 set topPlusRadius [expr {$topPlusRadius * -1}] 763 # Hrm... the canvas has an issue with drawing diagonal segments 764 # of lines from the bottom to the top, so we have to draw this line 765 # backwards (ie, lt is actually the bottom, drawn from right to left) 766 set lt [list \ 767 $rightPlusRadius [expr {$h1-$h-1}] \ 768 [expr {$rightPlusRadius - $xBevel}] [expr {$h1 + $topPlusRadius}] \ 769 [expr {$xf - $xBevel}] [expr {$h1 + $top}] \ 770 [expr {$leftPlusRadius + $xBevel}] [expr {$h1 + $top}] \ 771 ] 772 set lb [list \ 773 [expr {$leftPlusRadius + $xBevel}] [expr {$h1 + $top}] \ 774 [expr {$xd + $xBevel}] [expr {$h1 + $topPlusRadius}] \ 775 $xd [expr {$h1-$h-1}] \ 776 ] 777 # Because we have to do this funky reverse order thing, we have to 778 # swap the top/bottom colors too. 779 set tmp $fgt 780 set fgt $fgb 781 set fgb $tmp 782 } else { 783 set lt [list \ 784 $xd $h \ 785 [expr {$xd + $xBevel}] $topPlusRadius \ 786 [expr {$leftPlusRadius + $xBevel}] $top \ 787 [expr {$xf + 1 - $xBevel}] $top \ 788 ] 789 set lb [list \ 790 [expr {$xf + 1 - $xBevel}] [expr {$top + 1}] \ 791 [expr {$rightPlusRadius - $xBevel}] $topPlusRadius \ 792 $rightPlusRadius $h \ 793 ] 794 } 795 796 set img [Widget::cget $path.f$page -image] 797 798 set ytext $top 799 if { $tabsOnBottom } { 800 # The "+ 2" below moves the text closer to the bottom of the tab, 801 # so it doesn't look so cramped. I should be able to achieve the 802 # same goal by changing the anchor of the text and using this formula: 803 # ytext = $top + $h1 - $textOffsetY 804 # but that doesn't quite work (I think the linespace from the text 805 # gets in the way) 806 incr ytext [expr {$h1 - $h + 2}] 807 } 808 incr ytext $textOffsetY 809 810 set xtext [expr {$xd + $textOffsetX}] 811 if { $img != "" } { 812 # if there's an image, put it on the left and move the text right 813 set ximg $xtext 814 incr xtext [expr {[image width $img] + 2}] 815 } 816 817 if { $data(select) == $page } { 818 set bd [Widget::cget $path -borderwidth] 819 if {$bd < 1} { set bd 1 } 820 set fg [_getoption $path $page -foreground] 821 } else { 822 set bd 1 823 if { [Widget::cget $path.f$page -state] == "normal" } { 824 set fg [_getoption $path $page -foreground] 825 } else { 826 set fg [_getoption $path $page -disabledforeground] 827 } 828 } 829 830 # --- creation ou modification de l'onglet -------------------------------- 831 # Sven 832 if { $create } { 833 # Create the tab region 834 eval [list $path.c create polygon] [concat $lt $lb] [list \ 835 -tag [list page p:$page $page:poly] \ 836 -outline $bg \ 837 -fill $bg \ 838 ] 839 eval [list $path.c create line] $lt [list \ 840 -tags [list page p:$page $page:top top] -fill $fgt -width $bd] 841 eval [list $path.c create line] $lb [list \ 842 -tags [list page p:$page $page:bot bot] -fill $fgb -width $bd] 843 $path.c create text $xtext $ytext \ 844 -text [Widget::cget $path.f$page -text] \ 845 -font [Widget::cget $path -font] \ 846 -fill $fg \ 847 -anchor nw \ 848 -tags [list page p:$page $page:text] 849 850 $path.c bind p:$page <ButtonPress-1> \ 851 [list NoteBook::_select $path $page] 852 $path.c bind p:$page <Enter> \ 853 [list NoteBook::_highlight on $path $page] 854 $path.c bind p:$page <Leave> \ 855 [list NoteBook::_highlight off $path $page] 856 } else { 857 $path.c coords "$page:text" $xtext $ytext 858 859 $path.c itemconfigure "$page:text" \ 860 -text [Widget::cget $path.f$page -text] \ 861 -font [Widget::cget $path -font] \ 862 -fill $fg 863 } 864 eval [list $path.c coords "$page:poly"] [concat $lt $lb] 865 eval [list $path.c coords "$page:top"] $lt 866 eval [list $path.c coords "$page:bot"] $lb 867 $path.c itemconfigure "$page:poly" -fill $bg -outline $bg 868 $path.c itemconfigure "$page:top" -fill $fgt -width $bd 869 $path.c itemconfigure "$page:bot" -fill $fgb -width $bd 870 871 # Sven end 872 873 if { $img != "" } { 874 # Sven 875 set id [$path.c find withtag $page:img] 876 if { [string equal $id ""] } { 877 set id [$path.c create image $ximg $ytext \ 878 -anchor nw \ 879 -tags [list page p:$page $page:img]] 880 } 881 $path.c coords $id $ximg $ytext 882 $path.c itemconfigure $id -image $img 883 # Sven end 884 } else { 885 $path.c delete $page:img 886 } 887 888 if { $data(select) == $page } { 889 $path.c raise p:$page 890 } elseif { $pos == 0 } { 891 if { $data(select) == "" } { 892 $path.c raise p:$page 893 } else { 894 $path.c lower p:$page p:$data(select) 895 } 896 } else { 897 set pred [lindex $data(pages) [expr {$pos-1}]] 898 if { $data(select) != $pred || $pos == 1 } { 899 $path.c lower p:$page p:$pred 900 } else { 901 $path.c lower p:$page p:[lindex $data(pages) [expr {$pos-2}]] 902 } 903 } 904} 905 906 907# ----------------------------------------------------------------------------- 908# Command NoteBook::_draw_arrows 909# ----------------------------------------------------------------------------- 910proc NoteBook::_draw_arrows { path } { 911 variable _warrow 912 variable $path 913 upvar 0 $path data 914 915 set w [expr {[winfo width $path]-1}] 916 set h [expr {$data(hpage)-1}] 917 set nbpages [llength $data(pages)] 918 set xl 0 919 set xr [expr {$w-$_warrow+1}] 920 # Sven 921 set side [Widget::cget $path -side] 922 if { [string equal $side "bottom"] } { 923 set h1 [expr {[winfo height $path]-1}] 924 set bd [Widget::cget $path -borderwidth] 925 if {$bd < 1} { set bd 1 } 926 set y0 [expr {$h1 - $data(hpage) + $bd}] 927 } else { 928 set y0 1 929 } 930 # Sven end (all y positions where replaced with $y0 later) 931 932 if { $data(base) > 0 } { 933 # Sven 934 if { ![llength [$path.c find withtag "leftarrow"]] } { 935 $path.c create window $xl $y0 \ 936 -width $_warrow \ 937 -height $h \ 938 -anchor nw \ 939 -window $path.c.fg \ 940 -tags "leftarrow" 941 } else { 942 $path.c coords "leftarrow" $xl $y0 943 $path.c itemconfigure "leftarrow" -width $_warrow -height $h 944 } 945 # Sven end 946 } else { 947 $path.c delete "leftarrow" 948 } 949 950 if { $data(base) < $nbpages-1 && 951 $data(wpage) + [_get_x_page $path 0] + 6 > $w } { 952 # Sven 953 if { ![llength [$path.c find withtag "rightarrow"]] } { 954 $path.c create window $xr $y0 \ 955 -width $_warrow \ 956 -height $h \ 957 -window $path.c.fd \ 958 -anchor nw \ 959 -tags "rightarrow" 960 } else { 961 $path.c coords "rightarrow" $xr $y0 962 $path.c itemconfigure "rightarrow" -width $_warrow -height $h 963 } 964 # Sven end 965 } else { 966 $path.c delete "rightarrow" 967 } 968} 969 970 971# ----------------------------------------------------------------------------- 972# Command NoteBook::_draw_area 973# ----------------------------------------------------------------------------- 974proc NoteBook::_draw_area { path } { 975 variable $path 976 upvar 0 $path data 977 978 set w [expr {[winfo width $path]-1}] 979 set h [expr {[winfo height $path]-1}] 980 set bd [Widget::cget $path -borderwidth] 981 if {$bd < 1} { set bd 1 } 982 set x0 [expr {$bd-1}] 983 984 set arcRadius [Widget::cget $path -arcradius] 985 986 # Sven 987 set side [Widget::cget $path -side] 988 if {"$side" == "bottom"} { 989 set y0 0 990 set y1 [expr {$h - $data(hpage)}] 991 set yo $y1 992 } else { 993 set y0 $data(hpage) 994 set y1 $h 995 set yo [expr {$h-$y0}] 996 } 997 # Sven end 998 set dbg $data(dbg) 999 set sel $data(select) 1000 if { $sel == "" } { 1001 set xd [expr {$w/2}] 1002 set xf $xd 1003 set lbg $data(dbg) 1004 } else { 1005 set xd [_get_x_page $path [lsearch $data(pages) $data(select)]] 1006 set xf [expr {$xd + $data($sel,width) + $arcRadius + 1}] 1007 set lbg $data(lbg) 1008 } 1009 1010 # Sven 1011 if { [llength [$path.c find withtag rect]] == 0} { 1012 $path.c create line $xd $y0 $x0 $y0 $x0 $y1 \ 1013 -tags "rect toprect1" 1014 $path.c create line $w $y0 $xf $y0 \ 1015 -tags "rect toprect2" 1016 $path.c create line 1 $h $w $h $w $y0 \ 1017 -tags "rect botrect" 1018 } 1019 if {"$side" == "bottom"} { 1020 $path.c coords "toprect1" $w $y0 $x0 $y0 $x0 $y1 1021 $path.c coords "toprect2" $x0 $y1 $xd $y1 1022 $path.c coords "botrect" $xf $y1 $w $y1 $w $y0 1023 $path.c itemconfigure "toprect1" -fill $lbg -width $bd 1024 $path.c itemconfigure "toprect2" -fill $dbg -width $bd 1025 $path.c itemconfigure "botrect" -fill $dbg -width $bd 1026 } else { 1027 $path.c coords "toprect1" $xd $y0 $x0 $y0 $x0 $y1 1028 $path.c coords "toprect2" $w $y0 $xf $y0 1029 $path.c coords "botrect" $x0 $h $w $h $w $y0 1030 $path.c itemconfigure "toprect1" -fill $lbg -width $bd 1031 $path.c itemconfigure "toprect2" -fill $lbg -width $bd 1032 $path.c itemconfigure "botrect" -fill $dbg -width $bd 1033 } 1034 $path.c raise "rect" 1035 # Sven end 1036 1037 if { $sel != "" } { 1038 # Sven 1039 if { [llength [$path.c find withtag "window"]] == 0 } { 1040 $path.c create window 2 [expr {$y0+1}] \ 1041 -width [expr {$w-3}] \ 1042 -height [expr {$yo-3}] \ 1043 -anchor nw \ 1044 -tags "window" \ 1045 -window $path.f$sel 1046 } 1047 $path.c coords "window" 2 [expr {$y0+1}] 1048 $path.c itemconfigure "window" \ 1049 -width [expr {$w-3}] \ 1050 -height [expr {$yo-3}] \ 1051 -window $path.f$sel 1052 # Sven end 1053 } else { 1054 $path.c delete "window" 1055 } 1056} 1057 1058 1059# ----------------------------------------------------------------------------- 1060# Command NoteBook::_resize 1061# ----------------------------------------------------------------------------- 1062proc NoteBook::_resize { path } { 1063 # Sven 1064 NoteBook::_redraw $path 1065 # Sven 1066} 1067 1068 1069# ----------------------------------------------------------------------------- 1070# Command NoteBook::_realize 1071# ----------------------------------------------------------------------------- 1072proc NoteBook::_realize { path } { 1073 variable $path 1074 upvar 0 $path data 1075 1076 if { [set width [Widget::cget $path -width]] == 0 || 1077 [set height [Widget::cget $path -height]] == 0 } { 1078 compute_size $path 1079 } 1080 1081 set data(realized) 1 1082 # Sven 1083 NoteBook::_redraw $path 1084 # Sven 1085 bind $path <Configure> "NoteBook::_resize $path" 1086} 1087