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