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