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