1# 2# Tabset Widget and the Tab Class 3# ---------------------------------------------------------------------- 4# A Tabset is a widget that contains a set of Tab buttons. 5# It displays these tabs in a row or column depending on it tabpos. 6# When a tab is clicked on, it becomes the only tab in the tab set that 7# is selected. All other tabs are deselected. The Tcl command prefix 8# associated with this tab (through the command tab configure option) 9# is invoked with the tab index number appended to its argument list. 10# This allows the Tabset to control another widget such as a Notebook. 11# 12# A Tab class is an [incr Tcl] class that displays either an image, 13# bitmap, or label in a graphic object on a canvas. This graphic object 14# can have a wide variety of appearances depending on the options set. 15# 16# WISH LIST: 17# This section lists possible future enhancements. 18# 19# 1) When too many tabs appear, a small scrollbar should appear to 20# move the tabs over. 21# 22# ---------------------------------------------------------------------- 23# AUTHOR: Bill W. Scott EMAIL: bscott@spd.dsccc.com 24# 25# @(#) $Id: tabset.itk,v 1.7 2002/02/25 04:47:17 mgbacke Exp $ 26# ---------------------------------------------------------------------- 27# Copyright (c) 1995 DSC Technologies Corporation 28# ====================================================================== 29# Permission to use, copy, modify, distribute and license this software 30# and its documentation for any purpose, and without fee or written 31# agreement with DSC, is hereby granted, provided that the above copyright 32# notice appears in all copies and that both the copyright notice and 33# warranty disclaimer below appear in supporting documentation, and that 34# the names of DSC Technologies Corporation or DSC Communications 35# Corporation not be used in advertising or publicity pertaining to the 36# software without specific, written prior permission. 37# 38# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING 39# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- 40# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE 41# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, 42# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL 43# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR 44# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, 45# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, 46# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS 47# SOFTWARE. 48# ====================================================================== 49 50# 51# Default resources. 52# 53option add *Tabset.width 0 widgetDefault 54option add *Tabset.height 0 widgetDefault 55option add *Tabset.equalTabs true widgetDefault 56option add *Tabset.tabPos s widgetDefault 57option add *Tabset.raiseSelect false widgetDefault 58option add *Tabset.start 4 widgetDefault 59option add *Tabset.margin 5 widgetDefault 60option add *Tabset.tabBorders true widgetDefault 61option add *Tabset.bevelAmount 0 widgetDefault 62option add *Tabset.padX 4 widgetDefault 63option add *Tabset.padY 4 widgetDefault 64option add *Tabset.gap overlap widgetDefault 65option add *Tabset.angle 20 widgetDefault 66option add *Tabset.font fixed widgetDefault 67option add *Tabset.state normal widgetDefault 68option add *Tabset.disabledForeground #a3a3a3 widgetDefault 69option add *Tabset.foreground black widgetDefault 70option add *Tabset.background #d9d9d9 widgetDefault 71option add *Tabset.selectForeground black widgetDefault 72option add *Tabset.selectBackground #ececec widgetDefault 73 74# 75# Usual options. 76# 77itk::usual Tabset { 78 keep -backdrop -background -cursor -disabledforeground -font -foreground \ 79 -selectbackground -selectforeground 80} 81 82# ------------------------------------------------------------------ 83# TABSET 84# ------------------------------------------------------------------ 85itcl::class iwidgets::Tabset { 86 inherit itk::Widget 87 88 constructor {args} {} 89 destructor {} 90 91 itk_option define -width width Width 0 92 itk_option define -equaltabs equalTabs EqualTabs true 93 itk_option define -height height Height 0 94 itk_option define -tabpos tabPos TabPos s 95 itk_option define -raiseselect raiseSelect RaiseSelect false 96 itk_option define -start start Start 4 97 itk_option define -margin margin Margin 5 98 itk_option define -tabborders tabBorders TabBorders true 99 itk_option define -bevelamount bevelAmount BevelAmount 0 100 itk_option define -padx padX PadX 4 101 itk_option define -pady padY PadY 4 102 itk_option define -gap gap Gap overlap 103 itk_option define -angle angle Angle 20 104 itk_option define -font font Font fixed 105 itk_option define -state state State normal 106 itk_option define \ 107 -disabledforeground disabledForeground DisabledForeground #a3a3a3 108 itk_option define -foreground foreground Foreground black 109 itk_option define -background background Background #d9d9d9 110 itk_option define -selectforeground selectForeground Background black 111 itk_option define -backdrop backdrop Backdrop white 112 itk_option define -selectbackground selectBackground Foreground #ececec 113 itk_option define -command command Command {} 114 115 public method configure {args} 116 public method add {args} 117 public method delete {args} 118 public method index {index} 119 public method insert {index args} 120 public method prev {} 121 public method next {} 122 public method select {index} 123 public method tabcget {index args} 124 public method tabconfigure {index args} 125 public method bbox {} 126 127 protected method _selectName {tabName} 128 129 private method _createTab {args} 130 private method _deleteTabs {fromTab toTab} 131 private method _index {pathList index select} 132 private method _tabConfigure {args} 133 private method _relayoutTabs {} 134 private method _drawBevelBorder {} 135 private method _calcNextTabOffset {tabName} 136 private method _tabBounds {} 137 private method _recalcCanvasGeom {} 138 private method _canvasReconfigure {width height} 139 private method _startMove {x y} 140 private method _moveTabs {x y} 141 private method _endMove {x y} 142 private method _configRelayout {} 143 144 private variable _width 0 ;# Width of the canvas in screen units 145 private variable _height 0 ;# Height of the canvas in screen units 146 private variable _selectedTop 0 ;# top edge of tab + a margin 147 private variable _deselectedTop 0 ;# top edge of tab + a margin&raiseamt 148 private variable _selectedLeft 0 ;# left edge of tab + a margin 149 private variable _deselectedLeft 0 ;# left edge of tab + a margin&raiseamt 150 private variable _tabs {} ;# our internal list of tabs 151 private variable _currTab -1 ;# numerical index # of selected tab 152 private variable _uniqueID 0 ;# used to create unique names 153 private variable _cmdStr {} ;# holds value of itk_option(-command) 154 ;# do not know why I need this! 155 private variable _canvasWidth 0 ;# set by canvasReconfigure, is can wid 156 private variable _canvasHeight 0 ;# set by canvasReconfigure, is can hgt 157 158 private variable _anchorX 0 ;# used by mouse scrolling methods 159 private variable _anchorY 0 ;# used by mouse scrolling methods 160 161 private variable _margin 0 ;# -margin in screen units 162 private variable _start 0 ;# -start in screen units 163 private variable _gap overlap ;# -gap in screen units 164 165 private variable _relayout false ;# flag tripped to tell whether to 166 ;# relayout tabs after the configure 167 private variable _skipRelayout false ;# flag that tells whether to skip 168 ;# relayouting out the tabs. used by 169 ;# _endMove. 170} 171 172# 173# Provide a lowercase access method for the Tabset class 174# 175proc ::iwidgets::tabset {pathName args} { 176 uplevel ::iwidgets::Tabset $pathName $args 177} 178 179# ---------------------------------------------------------------------- 180# CONSTRUCTOR 181# ---------------------------------------------------------------------- 182itcl::body iwidgets::Tabset::constructor {args} { 183 global tcl_platform 184 185 # 186 # Create the canvas that holds the tabs 187 # 188 itk_component add canvas { 189 canvas $itk_interior.canvas -highlightthickness 0 190 } { 191 keep -cursor -width -height 192 } 193 pack $itk_component(canvas) -fill both -expand yes -anchor nw 194 195 # ... This gives us a chance to redraw our bevel borders, etc when 196 # the size of our canvas changes... 197 bind $itk_component(canvas) <Configure> \ 198 [itcl::code $this _canvasReconfigure %w %h] 199 bind $itk_component(canvas) <Map> \ 200 [itcl::code $this _relayoutTabs] 201 202 203 # ... Allow button 2 scrolling as in label widget. 204 if {$tcl_platform(os) != "HP-UX"} { 205 bind $itk_component(canvas) <2> \ 206 [itcl::code $this _startMove %x %y] 207 bind $itk_component(canvas) <B2-Motion> \ 208 [itcl::code $this _moveTabs %x %y] 209 bind $itk_component(canvas) <ButtonRelease-2> \ 210 [itcl::code $this _endMove %x %y] 211 } 212 213 # @@@ 214 # @@@ Is there a better way? 215 # @@@ 216 217 bind $itk_component(hull) <Tab> [itcl::code $this next] 218 bind $itk_component(hull) <Shift-Tab> [itcl::code $this prev] 219 220 eval itk_initialize $args 221 222 _configRelayout 223 224 _recalcCanvasGeom 225 226} 227 228itcl::body iwidgets::Tabset::destructor {} { 229 foreach tab $_tabs { 230 itcl::delete object $tab 231 } 232} 233 234# ---------------------------------------------------------------------- 235# OPTIONS 236# ---------------------------------------------------------------------- 237 238# ---------------------------------------------------------------------- 239# OPTION -width 240# 241# Sets the width explicitly for the canvas of the tabset 242# ---------------------------------------------------------------------- 243itcl::configbody iwidgets::Tabset::width { 244 if {$itk_option(-width) != {}} { 245 } 246 set _width [winfo pixels $itk_interior $itk_option(-width)] 247} 248 249# ---------------------------------------------------------------------- 250# OPTION -equaltabs 251# 252# If set to true, causes horizontal tabs to be equal in 253# in width and vertical tabs to equal in height. 254# ---------------------------------------------------------------------- 255itcl::configbody iwidgets::Tabset::equaltabs { 256 if {$itk_option(-equaltabs) != {}} { 257 set _relayout true 258 } 259} 260 261# ---------------------------------------------------------------------- 262# OPTION -height 263# 264# Sets the height explicitly for the canvas of the tabset 265# ---------------------------------------------------------------------- 266itcl::configbody iwidgets::Tabset::height { 267 set _height [winfo pixels $itk_interior $itk_option(-height)] 268} 269 270# ---------------------------------------------------------------------- 271# OPTION -tabpos 272# 273# Sets the tab position of tabs, n, s, e, w 274# ---------------------------------------------------------------------- 275itcl::configbody iwidgets::Tabset::tabpos { 276 if {$itk_option(-tabpos) != {}} { 277 switch $itk_option(-tabpos) { 278 n { 279 _tabConfigure -invert true -orient horizontal 280 } 281 s { 282 _tabConfigure -invert false -orient horizontal 283 } 284 w { 285 _tabConfigure -invert false -orient vertical 286 } 287 e { 288 _tabConfigure -invert true -orient vertical 289 } 290 default { 291 error "bad anchor position\ 292 \"$itk_option(-tabpos)\" must be n, s, e, or w" 293 } 294 } 295 } 296} 297 298# ---------------------------------------------------------------------- 299# OPTION -raiseselect 300# 301# Sets whether to raise selected tabs slightly 302# ---------------------------------------------------------------------- 303itcl::configbody iwidgets::Tabset::raiseselect { 304 if {$itk_option(-raiseselect) != {}} { 305 set _relayout true 306 } 307} 308 309# ---------------------------------------------------------------------- 310# OPTION -start 311# 312# Sets the offset to start of tab set 313# ---------------------------------------------------------------------- 314itcl::configbody iwidgets::Tabset::start { 315 if {$itk_option(-start) != {}} { 316 set _start [winfo pixels $itk_interior $itk_option(-start)] 317 set _relayout true 318 } else { 319 set _start 4 320 } 321} 322 323# ---------------------------------------------------------------------- 324# OPTION -margin 325# 326# Sets the margin used above n tabs, below s tabs, left of e 327# tabs, right of w tabs 328# ---------------------------------------------------------------------- 329itcl::configbody iwidgets::Tabset::margin { 330 if {$itk_option(-margin) != {}} { 331 set _margin [winfo pixels $itk_interior $itk_option(-margin)] 332 set _relayout true 333 } else { 334 set _margin 5 335 } 336} 337 338# ---------------------------------------------------------------------- 339# OPTION -tabborders 340# 341# Boolean that specifies whether to draw the borders of 342# the unselected tabs (tabs in background) 343# ---------------------------------------------------------------------- 344itcl::configbody iwidgets::Tabset::tabborders { 345 if {$itk_option(-tabborders) != {}} { 346 _tabConfigure -tabborders $itk_option(-tabborders) 347 } 348} 349 350# ---------------------------------------------------------------------- 351# OPTION -bevelamount 352# 353# Specifies pixel size of tab corners. 0 means no corners. 354# ---------------------------------------------------------------------- 355itcl::configbody iwidgets::Tabset::bevelamount { 356 if {$itk_option(-bevelamount) != {}} { 357 _tabConfigure -bevelamount $itk_option(-bevelamount) 358 } 359} 360 361# ---------------------------------------------------------------------- 362# OPTION -padx 363# 364# Sets the padding in each tab to the left and right of label 365# I don't convert for fpixels, since Tab does it for me. 366# ---------------------------------------------------------------------- 367itcl::configbody iwidgets::Tabset::padx { 368 if {$itk_option(-padx) != {}} { 369 _tabConfigure -padx $itk_option(-padx) 370 } 371} 372 373# ---------------------------------------------------------------------- 374# OPTION -pady 375# 376# Sets the padding in each tab to the left and right of label 377# I don't convert for fpixels, since Tab does it for me. 378# ---------------------------------------------------------------------- 379itcl::configbody iwidgets::Tabset::pady { 380 if {$itk_option(-pady) != {}} { 381 _tabConfigure -pady $itk_option(-pady) 382 } 383} 384 385# ---------------------------------------------------------------------- 386# OPTION -gap 387# 388# Sets the amount of spacing between tabs in pixels 389# ---------------------------------------------------------------------- 390itcl::configbody iwidgets::Tabset::gap { 391 if {$itk_option(-gap) != {}} { 392 if {$itk_option(-gap) != "overlap"} { 393 set _gap [winfo pixels $itk_interior $itk_option(-gap)] 394 } else { 395 set _gap overlap 396 } 397 set _relayout true 398 } else { 399 set _gap overlap 400 } 401} 402 403# ---------------------------------------------------------------------- 404# OPTION -angle 405# 406# Sets the angle of the tab's sides 407# ---------------------------------------------------------------------- 408itcl::configbody iwidgets::Tabset::angle { 409 if {$itk_option(-angle) != {}} { 410 _tabConfigure -angle $itk_option(-angle) 411 } 412} 413 414# ---------------------------------------------------------------------- 415# OPTION -font 416# 417# Sets the font of the tab (SELECTED and UNSELECTED) 418# ---------------------------------------------------------------------- 419itcl::configbody iwidgets::Tabset::font { 420 if {$itk_option(-font) != {}} { 421 _tabConfigure -font $itk_option(-font) 422 } 423} 424 425# ---------------------------------------------------------------------- 426# OPTION -state 427# ---------------------------------------------------------------------- 428itcl::configbody iwidgets::Tabset::state { 429 if {$itk_option(-state) != {}} { 430 _tabConfigure -state $itk_option(-state) 431 } 432} 433 434# ---------------------------------------------------------------------- 435# OPTION -disabledforeground 436# ---------------------------------------------------------------------- 437itcl::configbody iwidgets::Tabset::disabledforeground { 438 if {$itk_option(-disabledforeground) != {}} { 439 _tabConfigure \ 440 -disabledforeground $itk_option(-disabledforeground) 441 } 442} 443 444# ---------------------------------------------------------------------- 445# OPTION -foreground 446# 447# Sets the foreground label color of UNSELECTED tabs 448# ---------------------------------------------------------------------- 449itcl::configbody iwidgets::Tabset::foreground { 450 _tabConfigure -foreground $itk_option(-foreground) 451} 452 453# ---------------------------------------------------------------------- 454# OPTION -background 455# 456# Sets the background color of UNSELECTED tabs 457# ---------------------------------------------------------------------- 458itcl::configbody iwidgets::Tabset::background { 459 if {$itk_option(-background) != {}} { 460 _tabConfigure -background $itk_option(-background) 461 } else { 462 _tabConfigure -background \ 463 [$itk_component(canvas) cget -background] 464 } 465} 466 467# ---------------------------------------------------------------------- 468# OPTION -selectforeground 469# 470# Sets the foreground label color of SELECTED tabs 471# ---------------------------------------------------------------------- 472itcl::configbody iwidgets::Tabset::selectforeground { 473 _tabConfigure -selectforeground $itk_option(-selectforeground) 474} 475 476# ---------------------------------------------------------------------- 477# OPTION -backdrop 478# 479# Sets the background color of the Tabset backdrop (behind the tabs) 480# ---------------------------------------------------------------------- 481itcl::configbody iwidgets::Tabset::backdrop { 482 if {$itk_option(-backdrop) != {}} { 483 $itk_component(canvas) configure \ 484 -background $itk_option(-backdrop) 485 } 486} 487 488# ---------------------------------------------------------------------- 489# OPTION -selectbackground 490# 491# Sets the background color of SELECTED tabs 492# ---------------------------------------------------------------------- 493itcl::configbody iwidgets::Tabset::selectbackground { 494 if {$itk_option(-selectbackground) != {}} { 495 } else { 496 #set _selectBackground \ 497 [$itk_component(canvas) cget -background] 498 } 499 _tabConfigure -selectbackground $itk_option(-selectbackground) 500} 501 502# ---------------------------------------------------------------------- 503# OPTION -command 504# 505# The command to invoke when a tab is hit. 506# ---------------------------------------------------------------------- 507itcl::configbody iwidgets::Tabset::command { 508 if {$itk_option(-command) != {}} { 509 set _cmdStr $itk_option(-command) 510 } 511} 512 513# ---------------------------------------------------------------------- 514# METHOD: add ?option value...? 515# 516# Creates a tab and appends it to the list of tabs. 517# processes tabconfigure for the tab added. 518# ---------------------------------------------------------------------- 519itcl::body iwidgets::Tabset::add {args} { 520 set tabName [eval _createTab $args] 521 lappend _tabs $tabName 522 523 _relayoutTabs 524 525 return $tabName 526} 527 528# ---------------------------------------------------------------------- 529# METHOD: configure ?option? ?value option value...? 530# 531# Acts as an addendum to the itk::Widget::configure method. 532# 533# Checks the _relayout flag to see if after configures are done 534# we need to relayout the tabs. 535# 536# _skipRelayout is set in the MB2 scroll methods, to avoid constant 537# relayout of tabs while dragging the mouse. 538# ---------------------------------------------------------------------- 539itcl::body iwidgets::Tabset::configure {args} { 540 set result [eval itk::Archetype::configure $args] 541 542 _configRelayout 543 544 return $result 545} 546 547itcl::body iwidgets::Tabset::_configRelayout {} { 548 # then relayout tabs if necessary 549 if { $_relayout } { 550 if { $_skipRelayout } { 551 } else { 552 _relayoutTabs 553 } 554 set _relayout false 555 } 556} 557 558# ---------------------------------------------------------------------- 559# METHOD: delete index1 ?index2? 560# 561# Deletes a tab or range of tabs from the tabset 562# ---------------------------------------------------------------------- 563itcl::body iwidgets::Tabset::delete {args} { 564 if { $_tabs == {} } { 565 error "can't delete tabs,\ 566 no tabs in the tabset named $itk_component(hull)" 567 } 568 569 set len [llength $args] 570 switch $len { 571 0 { 572 error "wrong # args: should be\ 573 \"$itk_component(hull) delete index1 ?index2?\"" 574 } 575 576 1 { 577 set fromTab [index [lindex $args 0]] 578 if { $fromTab == -1 } { 579 error "bad value for index1:\ 580 [lindex $args 0] in call to delete" 581 } 582 set toTab $fromTab 583 _deleteTabs $fromTab $toTab 584 } 585 586 2 { 587 set fromTab [index [lindex $args 0]] 588 if { $fromTab == -1 } { 589 error "bad value for index1:\ 590 [lindex $args 0] in call to delete" 591 } 592 set toTab [index [lindex $args 1]] 593 594 if { $toTab == -1 } { 595 error "bad value for index2:\ 596 [lindex $args 1] in call to delete" 597 } 598 _deleteTabs $fromTab $toTab 599 } 600 601 default { 602 error "wrong # args: should be\ 603 \"$itk_component(hull) delete index1 ?index2?\"" 604 } 605 } 606} 607 608# ---------------------------------------------------------------------- 609# METHOD: index index 610# 611# Given an index identifier returns the numeric index of the tab 612# ---------------------------------------------------------------------- 613itcl::body iwidgets::Tabset::index {index} { 614 return [_index $_tabs $index $_currTab] 615} 616 617# ---------------------------------------------------------------------- 618# METHOD: insert index ?option value...? 619# 620# Inserts a tab before a index. The before tab may 621# be specified as a label or a tab position. 622# ---------------------------------------------------------------------- 623itcl::body iwidgets::Tabset::insert {index args} { 624 if { $_tabs == {} } { 625 error "no tab to insert before,\ 626 tabset '$itk_component(hull)' is empty" 627 } 628 629 # get the tab 630 set tab [index $index] 631 632 # catch bad value for before tab. 633 if { $tab < 0 || $tab >= [llength $_tabs] } { 634 error "bad value $tab for index:\ 635 should be between 0 and [expr {[llength $_tabs] - 1}]" 636 } 637 638 # create the new tab and get its name... 639 set tabName [eval _createTab $args] 640 641 # grab the name of the tab currently selected. (to keep in sync) 642 set currTabName [lindex $_tabs $_currTab] 643 644 # insert tabName before $tab 645 set _tabs [linsert $_tabs $tab $tabName] 646 647 # keep the _currTab in sync with the insert. 648 set _currTab [lsearch -exact $_tabs $currTabName] 649 650 _relayoutTabs 651 652 return $tabName 653} 654 655# ---------------------------------------------------------------------- 656# METHOD: prev 657# 658# Selects the prev tab. Wraps at first back to last tab. 659# ---------------------------------------------------------------------- 660itcl::body iwidgets::Tabset::prev {} { 661 if { $_tabs == {} } { 662 error "can't goto previous tab,\ 663 no tabs in the tabset: $itk_component(hull)" 664 } 665 666 # bump to the previous tab and wrap if necessary 667 set prev [expr {$_currTab - 1}] 668 if { $prev < 0 } { 669 set prev [expr {[llength $_tabs] - 1}] 670 } 671 672 select $prev 673 674} 675 676# ---------------------------------------------------------------------- 677# METHOD: next 678# 679# Selects the next tab. Wraps at last back to first tab. 680# ---------------------------------------------------------------------- 681itcl::body iwidgets::Tabset::next {} { 682 if { $_tabs == {} } { 683 error "can't goto next tab,\ 684 no tabs in the tabset: $itk_component(hull)" 685 } 686 687 # bump to the next tab and wrap if necessary 688 set next [expr {$_currTab + 1}] 689 if { $next >= [llength $_tabs] } { 690 set next 0 691 } 692 693 select $next 694} 695 696# ---------------------------------------------------------------------- 697# METHOD: select index 698# 699# Select a tab by index 700# 701# Lowers the last _currTab if it existed. 702# Then raises the new one if it exists. 703# 704# Returns numeric index of selection, -1 if failed. 705# ------------------------------------------------------------- 706itcl::body iwidgets::Tabset::select {index} { 707 if { $_tabs == {} } { 708 error "can't activate a tab,\ 709 no tabs in the tabset: $itk_component(hull)" 710 } 711 712 # if there is not current selection just ignore trying this selection 713 if { $index == "select" && $_currTab == -1 } { 714 return -1 715 } 716 717 # is selection request in range ? 718 set reqTab [index $index] 719 if { $reqTab == -1 } { 720 error "bad value $index for index:\ 721 should be from 0 to [expr {[llength $_tabs] - 1}]" 722 } 723 724 # If already selected then ignore and return... 725 if { $reqTab == $_currTab } { 726 return $reqTab 727 } 728 729 # ---- Deselect 730 if { $_currTab != -1 } { 731 set currTabName [lindex $_tabs $_currTab] 732 $currTabName deselect 733 734 # handle different orientations... 735 if { $itk_option(-tabpos) == "n" || $itk_option(-tabpos) == "s"} { 736 $currTabName configure -top $_deselectedTop 737 } else { 738 $currTabName configure -left $_deselectedLeft 739 } 740 } 741 742 # get the stacking order correct... 743 foreach tab $_tabs { 744 $tab lower 745 } 746 747 # set this now so that the -command cmd can do an 'index select' 748 # to operate on this tab. 749 set _currTab $reqTab 750 751 # ---- Select 752 set reqTabName [lindex $_tabs $reqTab] 753 $reqTabName select 754 if { $itk_option(-tabpos) == "n" || $itk_option(-tabpos) == "s"} { 755 $reqTabName configure -top $_selectedTop 756 } else { 757 $reqTabName configure -left $_selectedLeft 758 } 759 760 set _currTab $reqTab 761 762 # invoke any user command string, appended with tab index number 763 if { $_cmdStr != {} } { 764 set newCmd $_cmdStr 765 eval [lappend newCmd $reqTab] 766 } 767 768 return $reqTab 769} 770 771# ---------------------------------------------------------------------- 772# METHOD: tabcget index ?option? 773# 774# Returns the value for the option setting of the tab at index $index. 775# ---------------------------------------------------------------------- 776itcl::body iwidgets::Tabset::tabcget {index args} { 777 return [lindex [eval tabconfigure $index $args] 2] 778} 779 780# ---------------------------------------------------------------------- 781# METHOD: tabconfigure index ?option? ?value option value? 782# 783# tabconfigure index : returns configuration list 784# tabconfigure index -option : returns option values 785# tabconfigure index ?option value option value ...? sets options 786# and returns empty string. 787# 788# Performs configure on a given tab denoted by index. 789# 790# Index may be a tab number or a pattern matching the label 791# associated with a tab. 792# ---------------------------------------------------------------------- 793itcl::body iwidgets::Tabset::tabconfigure {index args} { 794 # convert index to numeric 795 set tab [index $index] 796 797 if { $tab == -1 } { 798 error "bad index value:\ 799 $index for $itk_component(hull) tabconfigure" 800 } 801 802 set tabName [lindex $_tabs $tab] 803 804 set len [llength $args] 805 switch $len { 806 0 { 807 return [eval $tabName configure] 808 } 809 1 { 810 return [eval $tabName configure $args] 811 } 812 default { 813 eval $tabName configure $args 814 _relayoutTabs 815 select select 816 } 817 } 818 return "" 819} 820 821# ---------------------------------------------------------------------- 822# METHOD: bbox 823# 824# calculates the bounding box that will completely enclose 825# all the tabs. 826# ---------------------------------------------------------------------- 827itcl::body iwidgets::Tabset::bbox {} { 828 return [_tabBounds] 829} 830 831# ---------------------------------------------------------------------- 832# PROTECTED METHOD: _selectName 833# 834# internal method to allow selection by internal tab name 835# rather than index. This is used by the bind methods 836# ---------------------------------------------------------------------- 837itcl::body iwidgets::Tabset::_selectName {tabName} { 838 # if the tab is disabled, then ignore this selection... 839 if { [$tabName cget -state] == "disabled" } { 840 return 841 } 842 843 set tab [lsearch -exact $_tabs $tabName] 844 select $tab 845} 846 847# ---------------------------------------------------------------------- 848# PRIVATE METHOD: _createTab 849# 850# Creates a tab, using unique tab naming, propagates background 851# and keeps unique id up to date. 852# ---------------------------------------------------------------------- 853itcl::body iwidgets::Tabset::_createTab {args} { 854 # 855 # create an internal name for the tab: tab0, tab1, etc. 856 # these are one-up numbers they do not 857 # correspond to the position the tab is located in. 858 # 859 set tabName $this-tab$_uniqueID 860 861 switch $itk_option(-tabpos) { 862 n { 863 set invert true 864 set orient horizontal 865 set x 0 866 set y [expr {$_margin + 1}] 867 } 868 s { 869 set invert false 870 set orient horizontal 871 set x 0 872 set y 0 873 } 874 w { 875 set invert false 876 set orient vertical 877 set x 0 878 set y 0 879 } 880 e { 881 set invert true 882 set orient vertical 883 set x [expr {$_margin + 1}] 884 set y 0 885 } 886 default { 887 error "bad anchor position\ 888 \"$itk_option(-tabpos)\" must be n, s, e, or w" 889 } 890 } 891 892 eval iwidgets::Tab $tabName $itk_component(canvas) \ 893 -left $x \ 894 -top $y \ 895 -font [list $itk_option(-font)] \ 896 -background $itk_option(-background) \ 897 -foreground $itk_option(-foreground) \ 898 -selectforeground $itk_option(-selectforeground) \ 899 -disabledforeground $itk_option(-disabledforeground) \ 900 -selectbackground $itk_option(-selectbackground) \ 901 -angle $itk_option(-angle) \ 902 -padx $itk_option(-padx) \ 903 -pady $itk_option(-pady) \ 904 -bevelamount $itk_option(-bevelamount) \ 905 -state $itk_option(-state) \ 906 -tabborders $itk_option(-tabborders) \ 907 -invert $invert \ 908 -orient $orient \ 909 $args 910 911 $tabName lower 912 913 $itk_component(canvas) \ 914 bind $tabName <Button-1> [itcl::code $this _selectName $tabName] 915 916 incr _uniqueID 917 918 return $tabName 919} 920 921# ---------------------------------------------------------------------- 922# PRIVATE METHOD: _deleteTabs 923# 924# Deletes tabs from $fromTab to $toTab. 925# 926# Operates in two passes, destroys all the widgets 927# Then removes the pathName from the tab list 928# 929# Also keeps the current selection in bounds. 930# ---------------------------------------------------------------------- 931itcl::body iwidgets::Tabset::_deleteTabs {fromTab toTab} { 932 for { set tab $fromTab } { $tab <= $toTab } { incr tab } { 933 set tabName [lindex $_tabs $tab] 934 935 # unbind Button-1 from this window name 936 $itk_component(canvas) bind $tabName <Button-1> {} 937 938 # Destroy the Tab class... 939 itcl::delete object $tabName 940 } 941 942 # physically remove the tab 943 set _tabs [lreplace $_tabs $fromTab $toTab] 944 945 # If we deleted a selected tab set our selection to none 946 if { $_currTab >= $fromTab && $_currTab <= $toTab } { 947 set _currTab -1 948 _drawBevelBorder 949 } 950 951 # make sure _currTab stays in sync with new numbering... 952 if { $_tabs == {} } { 953 # if deleted only remaining tab, 954 # reset current tab to undefined 955 set _currTab -1 956 957 # or if the current tab was the last tab, it needs come back 958 } elseif { $_currTab >= [llength $_tabs] } { 959 incr _currTab -1 960 if { $_currTab < 0 } { 961 # but only to zero 962 set _currTab 0 963 } 964 } 965 966 _relayoutTabs 967} 968 969# ---------------------------------------------------------------------- 970# PRIVATE METHOD: _index 971# 972# pathList : list of path names to search thru if index is a label 973# index : either number, 'select', 'end', or pattern 974# select : current selection 975# 976# _index takes takes the value $index converts it to 977# a numeric identifier. If the value is not already 978# an integer it looks it up in the $pathList array. 979# If it fails it returns -1 980# ---------------------------------------------------------------------- 981itcl::body iwidgets::Tabset::_index {pathList index select} { 982 switch $index { 983 select { 984 set number $select 985 } 986 end { 987 set number [expr {[llength $pathList] -1}] 988 } 989 default { 990 # is it an number already? 991 if { [regexp {^[0-9]+$} $index] } { 992 set number $index 993 if { $number < 0 || $number >= [llength $pathList] } { 994 set number -1 995 } 996 997 # otherwise it is a label 998 } else { 999 # look thru the pathList of pathNames and 1000 # get each label and compare with index. 1001 # if we get a match then set number to postion in $pathList 1002 # and break out. 1003 # otherwise number is still -1 1004 set i 0 1005 set number -1 1006 foreach pathName $pathList { 1007 set label [$pathName cget -label] 1008 if { $label == $index } { 1009 set number $i 1010 break 1011 } 1012 incr i 1013 } 1014 } 1015 } 1016 } 1017 1018 return $number 1019} 1020 1021# ---------------------------------------------------------------------- 1022# PRIVATE METHOD: _tabConfigure 1023# ---------------------------------------------------------------------- 1024itcl::body iwidgets::Tabset::_tabConfigure {args} { 1025 foreach tab $_tabs { 1026 eval $tab configure $args 1027 } 1028 1029 set _relayout true 1030 1031 if { $_tabs != {} } { 1032 select select 1033 } 1034} 1035 1036# ---------------------------------------------------------------------- 1037# PRIVATE METHOD: _relayoutTabs 1038# 1039# relays out the tabs with correct spacing... 1040# ---------------------------------------------------------------------- 1041itcl::body iwidgets::Tabset::_relayoutTabs {} { 1042 if { [llength $_tabs] == 0 || ![winfo viewable $itk_component(hull)]} { 1043 return 1044 } 1045 1046 # get the max width for fixed width tabs... 1047 set maxWidth 0 1048 foreach tab $_tabs { 1049 set width [$tab labelwidth] 1050 if { $width > $maxWidth } { 1051 set maxWidth $width 1052 } 1053 } 1054 1055 # get the max height for fixed height tabs... 1056 set maxHeight 0 1057 foreach tab $_tabs { 1058 set height [$tab labelheight] 1059 if { $height > $maxHeight } { 1060 set maxHeight $height 1061 } 1062 } 1063 1064 # get curr tab's name 1065 set currTabName [lindex $_tabs $_currTab] 1066 1067 # Start with our margin offset in pixels... 1068 set tabStart $_start 1069 1070 if { $itk_option(-raiseselect) } { 1071 set raiseAmt 2 1072 } else { 1073 set raiseAmt 0 1074 } 1075 1076 # 1077 # Depending on the tab layout: n, s, e, or w place the tabs 1078 # according to orientation, raise, margins, etc. 1079 # 1080 switch $itk_option(-tabpos) { 1081 n { 1082 set _selectedTop [expr {$_margin + 1}] 1083 set _deselectedTop [expr {$_selectedTop + $raiseAmt}] 1084 1085 if { $itk_option(-equaltabs) } { 1086 set tabWidth $maxWidth 1087 } else { 1088 set tabWidth 0 1089 } 1090 1091 foreach tab $_tabs { 1092 if { $tab == $currTabName } { 1093 $tab configure -left $tabStart -top $_selectedTop \ 1094 -height $maxHeight -width $tabWidth -anchor c 1095 } else { 1096 $tab configure -left $tabStart -top $_deselectedTop \ 1097 -height $maxHeight -width $tabWidth -anchor c 1098 } 1099 set tabStart [expr {$tabStart + [_calcNextTabOffset $tab]}] 1100 } 1101 1102 } 1103 s { 1104 set _selectedTop 0 1105 set _deselectedTop [expr {$_selectedTop - $raiseAmt}] 1106 1107 if { $itk_option(-equaltabs) } { 1108 set tabWidth $maxWidth 1109 } else { 1110 set tabWidth 0 1111 } 1112 1113 foreach tab $_tabs { 1114 if { $tab == $currTabName } { 1115 $tab configure -left $tabStart -top $_selectedTop \ 1116 -height $maxHeight -width $tabWidth -anchor c 1117 } else { 1118 $tab configure -left $tabStart -top $_deselectedTop \ 1119 -height $maxHeight -width $tabWidth -anchor c 1120 } 1121 set tabStart [expr {$tabStart + [_calcNextTabOffset $tab]}] 1122 } 1123 1124 } 1125 w { 1126 set _selectedLeft [expr {$_margin + 1}] 1127 set _deselectedLeft [expr {$_selectedLeft + $raiseAmt}] 1128 1129 if { $itk_option(-equaltabs) } { 1130 set tabHeight $maxHeight 1131 } else { 1132 set tabHeight 0 1133 } 1134 1135 foreach tab $_tabs { 1136 # selected 1137 if { $tab == $currTabName } { 1138 $tab configure -top $tabStart -left $_selectedLeft \ 1139 -height $tabHeight -width $maxWidth -anchor e 1140 # deselected 1141 } else { 1142 $tab configure -top $tabStart -left $_deselectedLeft \ 1143 -height $tabHeight -width $maxWidth -anchor e 1144 } 1145 set tabStart [expr {$tabStart + [_calcNextTabOffset $tab]}] 1146 } 1147 1148 } 1149 e { 1150 set _selectedLeft 0 1151 set _deselectedLeft [expr {$_selectedLeft - $raiseAmt}] 1152 1153 if { $itk_option(-equaltabs) } { 1154 set tabHeight $maxHeight 1155 } else { 1156 set tabHeight 0 1157 } 1158 1159 foreach tab $_tabs { 1160 # selected 1161 if { $tab == $currTabName } { 1162 $tab configure -top $tabStart -left $_selectedLeft \ 1163 -height $tabHeight -width $maxWidth -anchor w 1164 # deselected 1165 } else { 1166 $tab configure -top $tabStart -left $_deselectedLeft \ 1167 -height $tabHeight -width $maxWidth -anchor w 1168 } 1169 set tabStart [expr {$tabStart + [_calcNextTabOffset $tab]}] 1170 } 1171 1172 } 1173 default { 1174 error "bad anchor position\ 1175 \"$itk_option(-tabpos)\" must be n, s, e, or w" 1176 } 1177 } 1178 1179 # put border on & calc our new canvas size... 1180 _drawBevelBorder 1181 _recalcCanvasGeom 1182 1183} 1184 1185# ---------------------------------------------------------------------- 1186# PRIVATE METHOD: _drawBevelBorder 1187# 1188# draws the bevel border along tab edge (below selected tab) 1189# ---------------------------------------------------------------------- 1190itcl::body iwidgets::Tabset::_drawBevelBorder {} { 1191 $itk_component(canvas) delete bevelBorder 1192 1193 switch $itk_option(-tabpos) { 1194 n { 1195 $itk_component(canvas) create line \ 1196 0 [expr {$_canvasHeight - 1}] \ 1197 $_canvasWidth [expr {$_canvasHeight - 1}] \ 1198 -fill [iwidgets::colors::topShadow $itk_option(-selectbackground)] \ 1199 -tags bevelBorder 1200 $itk_component(canvas) create line \ 1201 0 $_canvasHeight \ 1202 $_canvasWidth $_canvasHeight \ 1203 -fill [iwidgets::colors::topShadow $itk_option(-selectbackground)] \ 1204 -tags bevelBorder 1205 } 1206 s { 1207 $itk_component(canvas) create line \ 1208 0 0 \ 1209 $_canvasWidth 0 \ 1210 -fill [iwidgets::colors::bottomShadow $itk_option(-selectbackground)] \ 1211 -tags bevelBorder 1212 $itk_component(canvas) create line \ 1213 0 1 \ 1214 $_canvasWidth 1 \ 1215 -fill black \ 1216 -tags bevelBorder 1217 } 1218 w { 1219 $itk_component(canvas) create line \ 1220 $_canvasWidth 0 \ 1221 $_canvasWidth [expr {$_canvasHeight - 1}] \ 1222 -fill [iwidgets::colors::topShadow $itk_option(-selectbackground)] \ 1223 -tags bevelBorder 1224 $itk_component(canvas) create line \ 1225 [expr {$_canvasWidth - 1}] 0 \ 1226 [expr {$_canvasWidth - 1}] [expr {$_canvasHeight - 1}] \ 1227 -fill [iwidgets::colors::topShadow $itk_option(-selectbackground)] \ 1228 -tags bevelBorder 1229 1230 } 1231 e { 1232 $itk_component(canvas) create line \ 1233 0 0 \ 1234 0 [expr {$_canvasHeight - 1}] \ 1235 -fill black \ 1236 -tags bevelBorder 1237 $itk_component(canvas) create line \ 1238 1 0 \ 1239 1 [expr {$_canvasHeight - 1}] \ 1240 -fill [iwidgets::colors::bottomShadow $itk_option(-selectbackground)] \ 1241 -tags bevelBorder 1242 1243 } 1244 } 1245 1246 $itk_component(canvas) raise bevelBorder 1247 if { $_currTab != -1 } { 1248 set currTabName [lindex $_tabs $_currTab] 1249 $currTabName raise 1250 } 1251} 1252 1253# ---------------------------------------------------------------------- 1254# PRIVATE METHOD: _calcNextTabOffset 1255# 1256# given $tabName, determines the offset in pixels to place 1257# the next tab's start edge at. 1258# ---------------------------------------------------------------------- 1259itcl::body iwidgets::Tabset::_calcNextTabOffset {tabName} { 1260 if { $_gap == "overlap" } { 1261 return [$tabName offset] 1262 } else { 1263 return [expr {[$tabName majordim] + $_gap}] 1264 } 1265} 1266 1267# ---------------------------------------------------------------------- 1268# PRIVATE METHOD: _tabBounds 1269# 1270# calculates the bounding box that will completely enclose 1271# all the tabs. 1272# ---------------------------------------------------------------------- 1273itcl::body iwidgets::Tabset::_tabBounds {} { 1274 set bbox { 100000 100000 -10000 -10000 } 1275 foreach tab $_tabs { 1276 set tabBBox [$tab bbox] 1277 # if this left is less use it 1278 if { [lindex $tabBBox 0] < [lindex $bbox 0] } { 1279 set bbox [lreplace $bbox 0 0 [lindex $tabBBox 0]] 1280 } 1281 # if this top is greater use it 1282 if { [lindex $tabBBox 1] < [lindex $bbox 1] } { 1283 set bbox [lreplace $bbox 1 1 [lindex $tabBBox 1]] 1284 } 1285 # if this right is less use it 1286 if { [lindex $tabBBox 2] > [lindex $bbox 2] } { 1287 set bbox [lreplace $bbox 2 2 [lindex $tabBBox 2]] 1288 } 1289 # if this bottom is greater use it 1290 if { [lindex $tabBBox 3] > [lindex $bbox 3] } { 1291 set bbox [lreplace $bbox 3 3 [lindex $tabBBox 3]] 1292 } 1293 1294 } 1295 return $bbox 1296} 1297 1298# ---------------------------------------------------------------------- 1299# PRIVATE METHOD: _recalcCanvasGeom 1300# 1301# Based on size of tabs, recalculates the canvas geometry that 1302# will hold the tabs. 1303# ---------------------------------------------------------------------- 1304itcl::body iwidgets::Tabset::_recalcCanvasGeom {} { 1305 if { [llength $_tabs] == 0 } { 1306 return 1307 } 1308 1309 set bbox [_tabBounds] 1310 1311 set width [lindex [_tabBounds] 2] 1312 set height [lindex [_tabBounds] 3] 1313 1314 # now we have the dimensions of all the tabs in the canvas. 1315 1316 1317 switch $itk_option(-tabpos) { 1318 n { 1319 # height already includes margin 1320 $itk_component(canvas) configure \ 1321 -width $width \ 1322 -height $height 1323 } 1324 s { 1325 $itk_component(canvas) configure \ 1326 -width $width \ 1327 -height [expr {$height + $_margin}] 1328 } 1329 w { 1330 # width already includes margin 1331 $itk_component(canvas) configure \ 1332 -width $width \ 1333 -height [expr {$height + 1}] 1334 } 1335 e { 1336 $itk_component(canvas) configure \ 1337 -width [expr {$width + $_margin}] \ 1338 -height [expr {$height + 1}] 1339 } 1340 default { 1341 } 1342 } 1343} 1344 1345# ---------------------------------------------------------------------- 1346# PRIVATE METHOD: _canvasReconfigure 1347# 1348# Bound to the reconfigure notify event of a canvas, this 1349# method resets canvas's correct width (since we are fill x) 1350# and redraws the beveled edge border. 1351# will hold the tabs. 1352# ---------------------------------------------------------------------- 1353itcl::body iwidgets::Tabset::_canvasReconfigure {width height} { 1354 set _canvasWidth $width 1355 set _canvasHeight $height 1356 1357 if { [llength $_tabs] > 0 } { 1358 _drawBevelBorder 1359 } 1360} 1361 1362# ---------------------------------------------------------------------- 1363# PRIVATE METHOD: _startMove 1364# 1365# This method is bound to the MB2 down in the canvas area of the 1366# tab set. This starts animated scrolling of the tabs along their 1367# major axis. 1368# ---------------------------------------------------------------------- 1369itcl::body iwidgets::Tabset::_startMove {x y} { 1370 if { $itk_option(-tabpos) == "n" || $itk_option(-tabpos) == "s" } { 1371 set _anchorX $x 1372 } else { 1373 set _anchorY $y 1374 } 1375} 1376 1377# ---------------------------------------------------------------------- 1378# PRIVATE METHOD: _moveTabs 1379# 1380# This method is bound to the MB2 motion in the canvas area of the 1381# tab set. This causes the tabset to move with the mouse. 1382# ---------------------------------------------------------------------- 1383itcl::body iwidgets::Tabset::_moveTabs {x y} { 1384 if { $itk_option(-tabpos) == "n" || $itk_option(-tabpos) == "s" } { 1385 set startX [expr {$_start + $x - $_anchorX}] 1386 foreach tab $_tabs { 1387 $tab configure -left $startX 1388 set startX [expr {$startX + [_calcNextTabOffset $tab]}] 1389 } 1390 } else { 1391 set startY [expr {$_start + $y - $_anchorY}] 1392 foreach tab $_tabs { 1393 $tab configure -top $startY 1394 set startY [expr {$startY + [_calcNextTabOffset $tab]}] 1395 } 1396 } 1397} 1398 1399# ---------------------------------------------------------------------- 1400# PRIVATE METHOD: _endMove 1401# 1402# This method is bound to the MB2 release in the canvas area of the 1403# tab set. This causes the tabset to end moving tabs. 1404# ---------------------------------------------------------------------- 1405itcl::body iwidgets::Tabset::_endMove {x y} { 1406 if { $itk_option(-tabpos) == "n" || $itk_option(-tabpos) == "s" } { 1407 set startX [expr {$_start + $x - $_anchorX}] 1408 set _skipRelayout true 1409 configure -start $startX 1410 set _skipRelayout false 1411 } else { 1412 set startY [expr {$_start + $y - $_anchorY}] 1413 set _skipRelayout true 1414 configure -start $startY 1415 set _skipRelayout false 1416 } 1417} 1418 1419 1420#============================================================== 1421# CLASS: Tab 1422#============================================================== 1423 1424itcl::class iwidgets::Tab { 1425 constructor {args} {} 1426 1427 destructor {} 1428 1429 public variable bevelamount 0 {} 1430 public variable state normal {} 1431 public variable height 0 {} 1432 public variable width 0 {} 1433 public variable anchor c {} 1434 public variable left 0 {} 1435 public variable top 0 {} 1436 public variable image {} {} 1437 public variable bitmap {} {} 1438 public variable label {} {} 1439 public variable padx 4 {} 1440 public variable pady 4 {} 1441 public variable selectbackground "gray70" {} 1442 public variable selectforeground "black" {} 1443 public variable disabledforeground "gray" {} 1444 public variable background "white" {} 1445 public variable foreground "black" {} 1446 public variable orient vertical {} 1447 public variable invert false {} 1448 public variable angle 20 {} 1449 public variable font \ 1450 "-adobe-helvetica-bold-r-normal--34-240-100-100-p-182-iso8859-1" {} 1451 public variable tabborders true {} 1452 1453 public method configure {args} 1454 public method bbox {} 1455 public method deselect {} 1456 public method lower {} 1457 public method majordim {} 1458 public method minordim {} 1459 public method offset {} 1460 public method raise {} 1461 public method select {} 1462 public method labelheight {} 1463 public method labelwidth {} 1464 1465 private method _makeTab {} 1466 private method _createLabel {canvas tagList} 1467 private method _makeEastTab {canvas} 1468 private method _makeWestTab {canvas} 1469 private method _makeNorthTab {canvas} 1470 private method _makeSouthTab {canvas} 1471 private method _calcLabelDim {labelItem} 1472 private method _itk_config {args} @itcl-builtin-configure 1473 private method _selectNoRaise {} 1474 private method _deselectNoLower {} 1475 1476 private variable _selected false 1477 private variable _padX 0 1478 private variable _padY 0 1479 1480 private variable _canvas 1481 1482 # these are in pixels 1483 private variable _left 0 1484 private variable _width 0 1485 private variable _height 0 1486 private variable _oldLeft 0 1487 private variable _top 0 1488 private variable _oldTop 0 1489 1490 private variable _right 1491 private variable _bottom 1492 1493 private variable _offset 1494 private variable _majorDim 1495 private variable _minorDim 1496 1497 private variable _darkShadow 1498 private variable _lightShadow 1499 1500 # 1501 # graphic components that make up a tab 1502 # 1503 private variable _gRegion 1504 private variable _gLabel 1505 private variable _gLightOutline {} 1506 private variable _gBlackOutline {} 1507 private variable _gTopLine 1508 private variable _gTopLineShadow 1509 private variable _gLightShadow 1510 private variable _gDarkShadow 1511 1512 private variable _labelWidth 0 1513 private variable _labelHeight 0 1514 1515 private variable _labelXOrigin 0 1516 private variable _labelYOrigin 0 1517 1518 private variable _just left 1519 1520 private variable _configTripped true 1521 1522 common _tan 1523 1524 set _tan(0) 0.0 1525 set _tan(1) 0.0175 1526 set _tan(2) 0.0349 1527 set _tan(3) 0.0524 1528 set _tan(4) 0.0699 1529 set _tan(5) 0.0875 1530 set _tan(6) 0.1051 1531 set _tan(7) 0.1228 1532 set _tan(8) 0.1405 1533 set _tan(9) 0.1584 1534 set _tan(10) 0.1763 1535 set _tan(11) 0.1944 1536 set _tan(12) 0.2126 1537 set _tan(13) 0.2309 1538 set _tan(14) 0.2493 1539 set _tan(15) 0.2679 1540 set _tan(16) 0.2867 1541 set _tan(17) 0.3057 1542 set _tan(18) 0.3249 1543 set _tan(19) 0.3443 1544 set _tan(20) 0.3640 1545 set _tan(21) 0.3839 1546 set _tan(22) 0.4040 1547 set _tan(23) 0.4245 1548 set _tan(24) 0.4452 1549 set _tan(25) 0.4663 1550 set _tan(26) 0.4877 1551 set _tan(27) 0.5095 1552 set _tan(28) 0.5317 1553 set _tan(29) 0.5543 1554 set _tan(30) 0.5774 1555 set _tan(31) 0.6009 1556 set _tan(32) 0.6294 1557 set _tan(33) 0.6494 1558 set _tan(34) 0.6745 1559 set _tan(35) 0.7002 1560 set _tan(36) 0.7265 1561 set _tan(37) 0.7536 1562 set _tan(38) 0.7813 1563 set _tan(39) 0.8098 1564 set _tan(40) 0.8391 1565 set _tan(41) 0.8693 1566 set _tan(42) 0.9004 1567 set _tan(43) 0.9325 1568 set _tan(44) 0.9657 1569 set _tan(45) 1.0 1570} 1571 1572# ---------------------------------------------------------------------- 1573# CONSTRUCTOR 1574# ---------------------------------------------------------------------- 1575itcl::body iwidgets::Tab::constructor {args} { 1576 1577 set _canvas [lindex $args 0] 1578 set args [lrange $args 1 [llength $args]] 1579 1580 set _darkShadow [iwidgets::colors::bottomShadow $selectbackground] 1581 set _lightShadow [iwidgets::colors::topShadow $selectbackground] 1582 1583 if { $args != "" } { 1584 eval configure $args 1585 } 1586} 1587 1588# ---------------------------------------------------------------------- 1589# DESTRUCTOR 1590# ---------------------------------------------------------------------- 1591itcl::body iwidgets::Tab::destructor {} { 1592 if { [winfo exists $_canvas] } { 1593 $_canvas delete $this 1594 } 1595} 1596 1597# ---------------------------------------------------------------------- 1598# OPTIONS 1599# ---------------------------------------------------------------------- 1600# 1601# Note, we trip _configTripped for every option that requires the tab 1602# to be remade. 1603# 1604# ---------------------------------------------------------------------- 1605# OPTION -bevelamount 1606# 1607# Specifies the size of tab corners. A value of 0 with angle set 1608# to 0 results in square tabs. A bevelAmount of 4, means that the 1609# tab will be drawn with angled corners that cut in 4 pixels from 1610# the edge of the tab. The default is 0. 1611# ---------------------------------------------------------------------- 1612itcl::configbody iwidgets::Tab::bevelamount { 1613} 1614 1615# ---------------------------------------------------------------------- 1616# OPTION -state 1617# 1618# sets the active state of the tab. specifying normal allows 1619# the tab to be selectable. Specifying disabled disables the tab, 1620# causing its image, bitmap, or label to be drawn with the 1621# disabledForeground color. 1622# ---------------------------------------------------------------------- 1623itcl::configbody iwidgets::Tab::state { 1624} 1625 1626# ---------------------------------------------------------------------- 1627# OPTION -height 1628# 1629# the height of the tab. if 0, uses the font label height. 1630# ---------------------------------------------------------------------- 1631itcl::configbody iwidgets::Tab::height { 1632 set _height [winfo pixels $_canvas $height] 1633 set _configTripped true 1634} 1635 1636# ---------------------------------------------------------------------- 1637# OPTION -width 1638# 1639# The width of the tab. If 0, uses the font label width. 1640# ---------------------------------------------------------------------- 1641itcl::configbody iwidgets::Tab::width { 1642 set _width [winfo pixels $_canvas $width] 1643 set _configTripped true 1644} 1645 1646# ---------------------------------------------------------------------- 1647# OPTION -anchor 1648# 1649# Where the text in the tab will be anchored: n,nw,ne,s,sw,se,e,w,center 1650# ---------------------------------------------------------------------- 1651itcl::configbody iwidgets::Tab::anchor { 1652} 1653 1654# ---------------------------------------------------------------------- 1655# OPTION -left 1656# 1657# Specifies the left edge of the tab's bounding box. This value 1658# may have any of the forms acceptable to Tk_GetPixels. 1659# ---------------------------------------------------------------------- 1660itcl::configbody iwidgets::Tab::left { 1661 1662 # get into pixels 1663 set _left [winfo pixels $_canvas $left] 1664 1665 # move by offset from last setting 1666 $_canvas move $this [expr {$_left - $_oldLeft}] 0 1667 1668 # update old for next time 1669 set _oldLeft $_left 1670} 1671 1672# ---------------------------------------------------------------------- 1673# OPTION -top 1674# 1675# Specifies the topedge of the tab's bounding box. This value may 1676# have any of the forms acceptable to Tk_GetPixels. 1677# ---------------------------------------------------------------------- 1678itcl::configbody iwidgets::Tab::top { 1679 1680 # get into pixels 1681 set _top [winfo pixels $_canvas $top] 1682 1683 # move by offset from last setting 1684 $_canvas move $this 0 [expr {$_top - $_oldTop}] 1685 1686 # update old for next time 1687 set _oldTop $_top 1688} 1689 1690# ---------------------------------------------------------------------- 1691# OPTION -image 1692# 1693# Specifies the imageto display in the tab. 1694# Images are created with the image create command. 1695# ---------------------------------------------------------------------- 1696itcl::configbody iwidgets::Tab::image { 1697 set _configTripped true 1698} 1699 1700# ---------------------------------------------------------------------- 1701# OPTION -bitmap 1702# 1703# If bitmap is an empty string, specifies the bitmap to display in 1704# the tab. Bitmap may be of any of the forms accepted by Tk_GetBitmap. 1705# ---------------------------------------------------------------------- 1706itcl::configbody iwidgets::Tab::bitmap { 1707 set _configTripped true 1708} 1709 1710# ---------------------------------------------------------------------- 1711# OPTION -label 1712# 1713# If image is an empty string and bitmap is an empty string, 1714# it specifies a text string to be placed in the tab's label. 1715# This label serves as an additional identifier used to reference 1716# the tab. Label may be used for the index value in widget commands. 1717# ---------------------------------------------------------------------- 1718itcl::configbody iwidgets::Tab::label { 1719 set _configTripped true 1720} 1721 1722# ---------------------------------------------------------------------- 1723# OPTION -padx 1724# 1725# Horizontal padding around the label (text, image, or bitmap). 1726# ---------------------------------------------------------------------- 1727itcl::configbody iwidgets::Tab::padx { 1728 set _configTripped true 1729 set _padX [winfo pixels $_canvas $padx] 1730} 1731 1732# ---------------------------------------------------------------------- 1733# OPTION -pady 1734# 1735# Vertical padding around the label (text, image, or bitmap). 1736# ---------------------------------------------------------------------- 1737itcl::configbody iwidgets::Tab::pady { 1738 set _configTripped true 1739 set _padY [winfo pixels $_canvas $pady] 1740} 1741 1742# ---------------------------------------------------------------------- 1743# OPTION -selectbackground 1744# ---------------------------------------------------------------------- 1745itcl::configbody iwidgets::Tab::selectbackground { 1746 set _darkShadow [iwidgets::colors::bottomShadow $selectbackground] 1747 set _lightShadow [iwidgets::colors::topShadow $selectbackground] 1748 1749 if { $_selected } { 1750 _selectNoRaise 1751 } else { 1752 _deselectNoLower 1753 } 1754} 1755 1756# ---------------------------------------------------------------------- 1757# OPTION -selectforeground 1758# 1759# Foreground of tab when selected 1760# ---------------------------------------------------------------------- 1761itcl::configbody iwidgets::Tab::selectforeground { 1762 if { $_selected } { 1763 _selectNoRaise 1764 } else { 1765 _deselectNoLower 1766 } 1767} 1768 1769# ---------------------------------------------------------------------- 1770# OPTION -disabledforeground 1771# 1772# Background of tab when -state is disabled 1773# ---------------------------------------------------------------------- 1774itcl::configbody iwidgets::Tab::disabledforeground { 1775 if { $_selected } { 1776 _selectNoRaise 1777 } else { 1778 _deselectNoLower 1779 } 1780} 1781 1782# ---------------------------------------------------------------------- 1783# OPTION -background 1784# 1785# Normal background of tab. 1786# ---------------------------------------------------------------------- 1787itcl::configbody iwidgets::Tab::background { 1788 1789 if { $_selected } { 1790 _selectNoRaise 1791 } else { 1792 _deselectNoLower 1793 } 1794 1795} 1796 1797# ---------------------------------------------------------------------- 1798# OPTION -foreground 1799# 1800# Foreground of tabs when in normal unselected state 1801# ---------------------------------------------------------------------- 1802itcl::configbody iwidgets::Tab::foreground { 1803 if { $_selected } { 1804 _selectNoRaise 1805 } else { 1806 _deselectNoLower 1807 } 1808} 1809 1810# ---------------------------------------------------------------------- 1811# OPTION -orient 1812# 1813# Specifies the orientation of the tab. Orient can be either 1814# horizontal or vertical. 1815# ---------------------------------------------------------------------- 1816itcl::configbody iwidgets::Tab::orient { 1817 set _configTripped true 1818} 1819 1820# ---------------------------------------------------------------------- 1821# OPTION -invert 1822# 1823# Specifies the direction to draw the tab. If invert is true, 1824# it draws horizontal tabs upside down and vertical tabs opening 1825# to the left (pointing right). The value may have any of the 1826# forms accepted by the Tcl_GetBoolean, such as true, 1827# false, 0, 1, yes, or no. 1828# ---------------------------------------------------------------------- 1829itcl::configbody iwidgets::Tab::invert { 1830 set _configTripped true 1831} 1832 1833# ---------------------------------------------------------------------- 1834# OPTION -angle 1835# 1836# Specifes the angle of slope from the inner edge to the outer edge 1837# of the tab. An angle of 0 specifies square tabs. Valid ranges are 1838# 0 to 45 degrees inclusive. Default is 15 degrees. If this option 1839# is specified as an empty string (the default), then the angle 1840# option for the overall Tabset is used. 1841# ---------------------------------------------------------------------- 1842itcl::configbody iwidgets::Tab::angle { 1843 if {$angle < 0 || $angle > 45 } { 1844 error "bad angle: must be between 0 and 45" 1845 } 1846 set _configTripped true 1847} 1848 1849# ---------------------------------------------------------------------- 1850# OPTION -font 1851# 1852# Font for tab text. 1853# ---------------------------------------------------------------------- 1854itcl::configbody iwidgets::Tab::font { 1855} 1856 1857 1858# ---------------------------------------------------------------------- 1859# OPTION -tabborders 1860# 1861# Specifies whether to draw the borders of a deselected tab. 1862# Specifying true (the default) draws these borders, 1863# specifying false disables this drawing. If the tab is in 1864# its selected state this option has no effect. 1865# The value may have any of the forms accepted by the 1866# Tcl_GetBoolean, such as true, false, 0, 1, yes, or no. 1867# ---------------------------------------------------------------------- 1868itcl::configbody iwidgets::Tab::tabborders { 1869 set _configTripped true 1870} 1871 1872# ---------------------------------------------------------------------- 1873# METHOD: configure ?option value? 1874# 1875# Configures the Tab, checks a configTripped flag to see if the tab 1876# needs to be remade. We take the easy way since it is so inexpensive 1877# to delete canvas items and remake them. 1878# ---------------------------------------------------------------------- 1879itcl::body iwidgets::Tab::configure {args} { 1880 set len [llength $args] 1881 1882 switch $len { 1883 0 { 1884 set result [_itk_config] 1885 return $result 1886 } 1887 1 { 1888 set result [eval _itk_config $args] 1889 return $result 1890 } 1891 default { 1892 eval _itk_config $args 1893 if { $_configTripped } { 1894 _makeTab 1895 set _configTripped false 1896 } 1897 return "" 1898 } 1899 } 1900} 1901 1902# ---------------------------------------------------------------------- 1903# METHOD: bbox 1904# 1905# Returns the bounding box of the tab 1906# ---------------------------------------------------------------------- 1907itcl::body iwidgets::Tab::bbox {} { 1908 return [lappend bbox $_left $_top $_right $_bottom] 1909} 1910# ---------------------------------------------------------------------- 1911# METHOD: deselect 1912# 1913# Causes the given tab to be drawn as deselected and lowered 1914# ---------------------------------------------------------------------- 1915itcl::body iwidgets::Tab::deselect {} { 1916 global tcl_platform 1917 $_canvas lower $this 1918 1919 if {$tcl_platform(os) == "HP-UX"} { 1920 update idletasks 1921 } 1922 1923 _deselectNoLower 1924} 1925 1926# ---------------------------------------------------------------------- 1927# METHOD: lower 1928# 1929# Lowers the tab below all others in the canvas. 1930# 1931# This is used as our tag name on the canvas. 1932# ---------------------------------------------------------------------- 1933itcl::body iwidgets::Tab::lower {} { 1934 $_canvas lower $this 1935} 1936 1937# ---------------------------------------------------------------------- 1938# METHOD: majordim 1939# 1940# Returns the width for horizontal tabs and the height for 1941# vertical tabs. 1942# ---------------------------------------------------------------------- 1943itcl::body iwidgets::Tab::majordim {} { 1944 return $_majorDim 1945} 1946 1947# ---------------------------------------------------------------------- 1948# METHOD: minordim 1949# 1950# Returns the height for horizontal tabs and the width for 1951# vertical tabs. 1952# ---------------------------------------------------------------------- 1953itcl::body iwidgets::Tab::minordim {} { 1954 return $_minorDim 1955} 1956 1957# ---------------------------------------------------------------------- 1958# METHOD: offset 1959# 1960# Returns the width less the angle offset. This allows a 1961# geometry manager to ask where to place a sibling tab. 1962# ---------------------------------------------------------------------- 1963itcl::body iwidgets::Tab::offset {} { 1964 return $_offset 1965} 1966 1967# ---------------------------------------------------------------------- 1968# METHOD: raise 1969# 1970# Raises the tab above all others in the canvas. 1971# 1972# This is used as our tag name on the canvas. 1973# ---------------------------------------------------------------------- 1974itcl::body iwidgets::Tab::raise {} { 1975 $_canvas raise $this 1976} 1977 1978# ---------------------------------------------------------------------- 1979# METHOD: select 1980# 1981# Causes the given tab to be drawn as selected. 3d shadows are 1982# turned on and top line and top line shadow are drawn in sel 1983# bg color to hide them. 1984# ---------------------------------------------------------------------- 1985itcl::body iwidgets::Tab::select {} { 1986 global tcl_platform 1987 $_canvas raise $this 1988 1989 if {$tcl_platform(os) == "HP-UX"} { 1990 update idletasks 1991 } 1992 1993 _selectNoRaise 1994} 1995 1996# ---------------------------------------------------------------------- 1997# METHOD: labelheight 1998# 1999# Returns the height of the tab's label in its current font. 2000# ---------------------------------------------------------------------- 2001itcl::body iwidgets::Tab::labelheight {} { 2002 if {$_gLabel != 0} { 2003 set labelBBox [$_canvas bbox $_gLabel] 2004 set labelHeight [expr {[lindex $labelBBox 3] - [lindex $labelBBox 1]}] 2005 } else { 2006 set labelHeight 0 2007 } 2008 return $labelHeight 2009} 2010 2011# ---------------------------------------------------------------------- 2012# METHOD: labelwidth 2013# 2014# Returns the width of the tab's label in its current font. 2015# ---------------------------------------------------------------------- 2016itcl::body iwidgets::Tab::labelwidth {} { 2017 if {$_gLabel != 0} { 2018 set labelBBox [$_canvas bbox $_gLabel] 2019 set labelWidth [expr {[lindex $labelBBox 2] - [lindex $labelBBox 0]}] 2020 } else { 2021 set labelWidth 0 2022 } 2023 return $labelWidth 2024} 2025 2026# ---------------------------------------------------------------------- 2027# PRIVATE METHOD: _selectNoRaise 2028# 2029# Draws tab as selected without raising it. 2030# ---------------------------------------------------------------------- 2031itcl::body iwidgets::Tab::_selectNoRaise {} { 2032 if { ! [info exists _gRegion] } { 2033 return 2034 } 2035 2036 $_canvas itemconfigure $_gRegion -fill $selectbackground 2037 $_canvas itemconfigure $_gTopLine -fill $selectbackground 2038 $_canvas itemconfigure $_gTopLineShadow -fill $selectbackground 2039 $_canvas itemconfigure $_gLightShadow -fill $_lightShadow 2040 $_canvas itemconfigure $_gDarkShadow -fill $_darkShadow 2041 2042 if { $_gLightOutline != {} } { 2043 $_canvas itemconfigure $_gLightOutline -fill $_lightShadow 2044 } 2045 if { $_gBlackOutline != {} } { 2046 $_canvas itemconfigure $_gBlackOutline -fill black 2047 } 2048 2049 if { $state == "normal" } { 2050 if { $image != {}} { 2051 # do nothing for now 2052 } elseif { $bitmap != {}} { 2053 $_canvas itemconfigure $_gLabel \ 2054 -foreground $selectforeground \ 2055 -background $selectbackground 2056 } else { 2057 $_canvas itemconfigure $_gLabel -fill $selectforeground 2058 } 2059 } else { 2060 if { $image != {}} { 2061 # do nothing for now 2062 } elseif { $bitmap != {}} { 2063 $_canvas itemconfigure $_gLabel \ 2064 -foreground $disabledforeground \ 2065 -background $selectbackground 2066 } else { 2067 $_canvas itemconfigure $_gLabel -fill $disabledforeground 2068 } 2069 } 2070 2071 set _selected true 2072} 2073 2074# ---------------------------------------------------------------------- 2075# PRIVATE METHOD: _deselectNoLower 2076# 2077# Causes the given tab to be drawn as deselected. 3d shadows are 2078# removed and top line and top line shadow are drawn in visible 2079# colors to reveal them. 2080# ---------------------------------------------------------------------- 2081itcl::body iwidgets::Tab::_deselectNoLower {} { 2082 if { ! [info exists _gRegion] } { 2083 return 2084 } 2085 2086 $_canvas itemconfigure $_gRegion -fill $background 2087 $_canvas itemconfigure $_gTopLine -fill black 2088 $_canvas itemconfigure $_gTopLineShadow -fill $_darkShadow 2089 $_canvas itemconfigure $_gLightShadow -fill $background 2090 $_canvas itemconfigure $_gDarkShadow -fill $background 2091 2092 if { $tabborders } { 2093 if { $_gLightOutline != {} } { 2094 $_canvas itemconfigure $_gLightOutline -fill $_lightShadow 2095 } 2096 if { $_gBlackOutline != {} } { 2097 $_canvas itemconfigure $_gBlackOutline -fill black 2098 } 2099 } else { 2100 if { $_gLightOutline != {} } { 2101 $_canvas itemconfigure $_gLightOutline -fill $background 2102 } 2103 if { $_gBlackOutline != {} } { 2104 $_canvas itemconfigure $_gBlackOutline -fill $background 2105 } 2106 } 2107 2108 2109 if { $state == "normal" } { 2110 if { $image != {}} { 2111 # do nothing for now 2112 } elseif { $bitmap != {}} { 2113 $_canvas itemconfigure $_gLabel \ 2114 -foreground $foreground \ 2115 -background $background 2116 } else { 2117 $_canvas itemconfigure $_gLabel -fill $foreground 2118 } 2119 } else { 2120 if { $image != {}} { 2121 # do nothing for now 2122 } elseif { $bitmap != {}} { 2123 $_canvas itemconfigure $_gLabel \ 2124 -foreground $disabledforeground \ 2125 -background $background 2126 } else { 2127 $_canvas itemconfigure $_gLabel -fill $disabledforeground 2128 } 2129 } 2130 2131 set _selected false 2132} 2133 2134# ---------------------------------------------------------------------- 2135# PRIVATE METHOD: _makeTab 2136# ---------------------------------------------------------------------- 2137itcl::body iwidgets::Tab::_makeTab {} { 2138 if { $orient == "horizontal" } { 2139 if { $invert } { 2140 _makeNorthTab $_canvas 2141 } else { 2142 _makeSouthTab $_canvas 2143 } 2144 } elseif { $orient == "vertical" } { 2145 if { $invert } { 2146 _makeEastTab $_canvas 2147 } else { 2148 _makeWestTab $_canvas 2149 } 2150 } else { 2151 error "bad value for option -orient" 2152 } 2153} 2154 2155# ---------------------------------------------------------------------- 2156# PRIVATE METHOD: _createLabel 2157# 2158# Creates the label for the tab. Can be either a text label 2159# or a bitmap label. 2160# ---------------------------------------------------------------------- 2161itcl::body iwidgets::Tab::_createLabel {canvas tagList} { 2162 if { $image != {}} { 2163 set _gLabel [$canvas create image \ 2164 0 0 \ 2165 -image $image \ 2166 -anchor nw \ 2167 -tags $tagList \ 2168 ] 2169 } elseif { $bitmap != {}} { 2170 set _gLabel [$canvas create bitmap \ 2171 0 0 \ 2172 -bitmap $bitmap \ 2173 -anchor nw \ 2174 -tags $tagList \ 2175 ] 2176 } else { 2177 set _gLabel [$canvas create text \ 2178 0 0 \ 2179 -text $label \ 2180 -font $font \ 2181 -anchor nw \ 2182 -tags $tagList \ 2183 ] 2184 } 2185} 2186 2187# ---------------------------------------------------------------------- 2188# PRIVATE METHOD: _makeEastTab 2189# 2190# Makes a tab that hangs to the east and opens to the west. 2191# ---------------------------------------------------------------------- 2192itcl::body iwidgets::Tab::_makeEastTab {canvas} { 2193 $canvas delete $this 2194 set _gLightOutline {} 2195 set _gBlackOutline {} 2196 2197 lappend tagList $this TAB 2198 2199 _createLabel $canvas $tagList 2200 2201 _calcLabelDim $_gLabel 2202 2203 2204 set right [expr {$_left + $_labelWidth}] 2205 # now have _left, _top, right... 2206 2207 # Turn off calculating angle tabs on Vertical orientations 2208 set angleOffset 0 2209 2210 set outerTop $_top 2211 set outerBottom \ 2212 [expr {$outerTop + $angleOffset + $_labelHeight + $angleOffset}] 2213 set innerTop [expr {$outerTop + $angleOffset}] 2214 set innerBottom [expr {$outerTop + $angleOffset + $_labelHeight}] 2215 2216 # now have _left, _top, right, outerTop, innerTop, 2217 # innerBottom, outerBottom, width, height 2218 2219 set bottom $innerBottom 2220 # tab area... gets filled either white or selected 2221 # done 2222 set _gRegion [$canvas create polygon \ 2223 $_left $outerTop \ 2224 [expr {$right - $bevelamount}] $innerTop \ 2225 $right [expr {$innerTop + $bevelamount}] \ 2226 $right [expr {$innerBottom - $bevelamount}] \ 2227 [expr {$right - $bevelamount}] $innerBottom \ 2228 $_left $outerBottom \ 2229 $_left $outerTop \ 2230 -tags $tagList \ 2231 ] 2232 2233 # lighter shadow (left edge) 2234 set _gLightShadow [$canvas create line \ 2235 [expr {$_left - 3}] [expr {$outerTop + 1}] \ 2236 [expr {$right - $bevelamount}] [expr {$innerTop + 1}] \ 2237 -tags $tagList \ 2238 ] 2239 2240 # darker shadow (bottom and right edges) 2241 set _gDarkShadow [$canvas create line \ 2242 [expr {$right - $bevelamount}] [expr {$innerTop + 1}] \ 2243 [expr {$right - 1}] [expr {$innerTop + $bevelamount}] \ 2244 [expr {$right - 1}] [expr {$innerBottom - $bevelamount}] \ 2245 [expr {$right - $bevelamount}] [expr {$innerBottom - 1}] \ 2246 [expr {$_left - 3}] [expr {$outerBottom - 1}] \ 2247 -tags $tagList \ 2248 ] 2249 2250 # outline of tab 2251 set _gLightOutline [$canvas create line \ 2252 $_left $outerTop \ 2253 [expr {$right - $bevelamount}] $innerTop \ 2254 -tags $tagList \ 2255 ] 2256 # outline of tab 2257 set _gBlackOutline [$canvas create line \ 2258 [expr {$right - $bevelamount}] $innerTop \ 2259 $right [expr {$innerTop + $bevelamount}] \ 2260 $right [expr {$innerBottom - $bevelamount}] \ 2261 [expr {$right - $bevelamount}] $innerBottom \ 2262 $_left $outerBottom \ 2263 $_left $outerTop \ 2264 -tags $tagList \ 2265 ] 2266 2267 # line closest to the edge 2268 set _gTopLineShadow [$canvas create line \ 2269 $_left $outerTop \ 2270 $_left $outerBottom \ 2271 -tags $tagList \ 2272 ] 2273 2274 # next line down 2275 set _gTopLine [$canvas create line \ 2276 [expr {$_left + 1}] [expr {$outerTop + 2}] \ 2277 [expr {$_left + 1}] [expr {$outerBottom - 1}] \ 2278 -tags $tagList \ 2279 ] 2280 2281 $canvas coords $_gLabel [expr {$_left + $_labelXOrigin}] \ 2282 [expr {$innerTop + $_labelYOrigin}] 2283 2284 if { $image != {} || $bitmap != {} } { 2285 $canvas itemconfigure $_gLabel -anchor $anchor 2286 } else { 2287 $canvas itemconfigure $_gLabel -anchor $anchor -justify $_just 2288 } 2289 2290 $canvas raise $_gLabel $_gRegion 2291 2292 2293 set _offset [expr {$innerBottom - $outerTop}] 2294 # height 2295 set _majorDim [expr {$outerBottom - $outerTop}] 2296 # width 2297 set _minorDim [expr {$right - $_left}] 2298 2299 set _right $right 2300 set _bottom $outerBottom 2301 2302 # draw in correct state... 2303 if { $_selected } { 2304 select 2305 } else { 2306 deselect 2307 } 2308} 2309 2310# ---------------------------------------------------------------------- 2311# PRIVATE METHOD: _makeWestTab 2312# 2313# Makes a tab that hangs to the west and opens to the east. 2314# ---------------------------------------------------------------------- 2315itcl::body iwidgets::Tab::_makeWestTab {canvas} { 2316 $canvas delete $this 2317 set _gLightOutline {} 2318 set _gBlackOutline {} 2319 2320 lappend tagList $this TAB 2321 2322 _createLabel $canvas $tagList 2323 _calcLabelDim $_gLabel 2324 2325 set right [expr {$_left + $_labelWidth}] 2326 # now have _left, _top, right... 2327 2328 # Turn off calculating angle tabs on Vertical orientations 2329 set angleOffset 0 2330 2331 set outerTop $_top 2332 set outerBottom \ 2333 [expr {$outerTop + $angleOffset + $_labelHeight + $angleOffset}] 2334 set innerTop [expr {$outerTop + $angleOffset}] 2335 set innerBottom [expr {$outerTop + $angleOffset + $_labelHeight}] 2336 2337 # now have _left, _top, right, outerTop, innerTop, 2338 # innerBottom, outerBottom, width, height 2339 2340 # tab area... gets filled either white or selected 2341 # done 2342 set _gRegion [$canvas create polygon \ 2343 $right $outerTop \ 2344 [expr {$_left + $bevelamount}] $innerTop \ 2345 $_left [expr {$innerTop + $bevelamount}] \ 2346 $_left [expr {$innerBottom - $bevelamount}]\ 2347 [expr {$_left + $bevelamount}] $innerBottom \ 2348 $right $outerBottom \ 2349 $right $outerTop \ 2350 -tags $tagList \ 2351 ] 2352 # lighter shadow (left edge) 2353 set _gLightShadow [$canvas create line \ 2354 $right [expr {$outerTop+1}] \ 2355 [expr {$_left + $bevelamount}] [expr {$innerTop + 1}] \ 2356 [expr {$_left + 1}] [expr {$innerTop + $bevelamount}] \ 2357 [expr {$_left + 1}] [expr {$innerBottom - $bevelamount}] \ 2358 -tags $tagList \ 2359 ] 2360 2361 # darker shadow (bottom and right edges) 2362 set _gDarkShadow [$canvas create line \ 2363 [expr {$_left + 1}] [expr {$innerBottom - $bevelamount}] \ 2364 [expr {$_left + $bevelamount}] [expr {$innerBottom - 1}] \ 2365 $right [expr {$outerBottom - 1}] \ 2366 -tags $tagList \ 2367 ] 2368 2369 # outline of tab -- lighter top left sides 2370 set _gLightOutline [$canvas create line \ 2371 $right $outerTop \ 2372 [expr {$_left + $bevelamount}] $innerTop \ 2373 $_left [expr {$innerTop + $bevelamount}] \ 2374 $_left [expr {$innerBottom - $bevelamount}]\ 2375 -tags $tagList \ 2376 ] 2377 # outline of tab -- darker bottom side 2378 set _gBlackOutline [$canvas create line \ 2379 $_left [expr {$innerBottom - $bevelamount}]\ 2380 [expr {$_left + $bevelamount}] $innerBottom \ 2381 $right $outerBottom \ 2382 $right $outerTop \ 2383 -tags $tagList \ 2384 ] 2385 2386 # top of tab 2387 set _gTopLine [$canvas create line \ 2388 [expr {$right + 1}] $outerTop \ 2389 [expr {$right + 1}] $outerBottom \ 2390 -tags $tagList \ 2391 ] 2392 2393 # line below top of tab 2394 set _gTopLineShadow [$canvas create line \ 2395 $right $outerTop \ 2396 $right $outerBottom \ 2397 -tags $tagList \ 2398 ] 2399 2400 $canvas coords $_gLabel [expr {$_left + $_labelXOrigin}] \ 2401 [expr {$innerTop + $_labelYOrigin}] 2402 if { $image != {} || $bitmap != {} } { 2403 $canvas itemconfigure $_gLabel -anchor $anchor 2404 } else { 2405 $canvas itemconfigure $_gLabel -anchor $anchor -justify $_just 2406 } 2407 2408 $canvas raise $_gLabel $_gRegion 2409 2410 2411 set _offset [expr {$innerBottom - $outerTop}] 2412 # height 2413 set _majorDim [expr {$outerBottom - $outerTop}] 2414 # width 2415 set _minorDim [expr {$right - $_left}] 2416 2417 set _right $right 2418 set _bottom $outerBottom 2419 2420 # draw in correct state... 2421 if { $_selected } { 2422 select 2423 } else { 2424 deselect 2425 } 2426 2427} 2428 2429# ---------------------------------------------------------------------- 2430# PRIVATE METHOD: _makeNorthTab 2431# 2432# Makes a tab that hangs to the north and opens to the south. 2433# ---------------------------------------------------------------------- 2434itcl::body iwidgets::Tab::_makeNorthTab {canvas} { 2435 $canvas delete $this 2436 set _gLightOutline {} 2437 set _gBlackOutline {} 2438 2439 lappend tagList $this TAB 2440 2441 _createLabel $canvas $tagList 2442 2443 # first get the label width and height 2444 _calcLabelDim $_gLabel 2445 2446 set bottom [expr {$_top + $_labelHeight}] 2447 2448 set angleOffset [expr {$_labelHeight * $_tan($angle)}] 2449 2450 set outerLeft $_left 2451 set outerRight \ 2452 [expr {$outerLeft + $angleOffset + $_labelWidth + $angleOffset}] 2453 set innerLeft [expr {$outerLeft + $angleOffset}] 2454 set innerRight [expr {$outerLeft + $angleOffset + $_labelWidth}] 2455 2456 # tab area... gets filled either white or selected 2457 set _gRegion [$canvas create polygon \ 2458 $outerLeft [expr {$bottom + 3}] \ 2459 $innerLeft [expr {$_top + $bevelamount}] \ 2460 [expr {$innerLeft + $bevelamount}] $_top \ 2461 [expr {$innerRight - $bevelamount}] $_top \ 2462 $innerRight [expr {$_top + $bevelamount}]\ 2463 $outerRight [expr {$bottom + 3}] \ 2464 $outerLeft [expr {$bottom + 3}] \ 2465 -tags $tagList \ 2466 ] 2467 2468 # lighter shadow (left edge) 2469 set _gLightShadow [$canvas create line \ 2470 [expr {$outerLeft + 1}] [expr {$bottom + 3}] \ 2471 [expr {$innerLeft + 1}] [expr {$_top + $bevelamount}] \ 2472 [expr {$innerLeft + $bevelamount}] [expr {$_top + 1}]\ 2473 [expr {$innerRight - $bevelamount}] [expr {$_top + 1}]\ 2474 -tags $tagList \ 2475 ] 2476 2477 # darker shadow (bottom and right edges) 2478 set _gDarkShadow [$canvas create line \ 2479 [expr {$innerRight - $bevelamount}] [expr {$_top + 1}]\ 2480 [expr {$innerRight - 1}] [expr {$_top + $bevelamount}]\ 2481 [expr {$outerRight - 1}] [expr {$bottom + 3}]\ 2482 -tags $tagList \ 2483 ] 2484 2485 set _gLightOutline [$canvas create line \ 2486 $outerLeft [expr {$bottom + 3}] \ 2487 $innerLeft [expr {$_top + $bevelamount}] \ 2488 [expr {$innerLeft + $bevelamount}] $_top \ 2489 [expr {$innerRight - $bevelamount}] $_top \ 2490 -tags $tagList \ 2491 ] 2492 2493 set _gBlackOutline [$canvas create line \ 2494 [expr {$innerRight - $bevelamount}] $_top \ 2495 $innerRight [expr {$_top + $bevelamount}]\ 2496 $outerRight [expr {$bottom + 3}] \ 2497 $outerLeft [expr {$bottom + 3}] \ 2498 -tags $tagList \ 2499 ] 2500 2501 # top of tab... to make it closed off 2502 set _gTopLine [$canvas create line \ 2503 0 0 0 0\ 2504 -tags $tagList \ 2505 ] 2506 2507 # top of tab... to make it closed off 2508 set _gTopLineShadow [$canvas create line \ 2509 0 0 0 0 \ 2510 -tags $tagList \ 2511 ] 2512 2513 $canvas coords $_gLabel [expr {$innerLeft + $_labelXOrigin}] \ 2514 [expr {$_top + $_labelYOrigin}] 2515 2516 if { $image != {} || $bitmap != {} } { 2517 $canvas itemconfigure $_gLabel -anchor $anchor 2518 } else { 2519 $canvas itemconfigure $_gLabel -anchor $anchor -justify $_just 2520 } 2521 2522 $canvas raise $_gLabel $_gRegion 2523 2524 2525 set _offset [expr {$innerRight - $outerLeft}] 2526 # width 2527 set _majorDim [expr {$outerRight - $outerLeft}] 2528 # height 2529 set _minorDim [expr {$bottom - $_top}] 2530 2531 set _right $outerRight 2532 set _bottom $bottom 2533 2534 # draw in correct state... 2535 if { $_selected } { 2536 select 2537 } else { 2538 deselect 2539 } 2540} 2541 2542# ---------------------------------------------------------------------- 2543# PRIVATE METHOD: _makeSouthTab 2544# 2545# Makes a tab that hangs to the south and opens to the north. 2546# ---------------------------------------------------------------------- 2547itcl::body iwidgets::Tab::_makeSouthTab {canvas} { 2548 $canvas delete $this 2549 set _gLightOutline {} 2550 set _gBlackOutline {} 2551 2552 lappend tagList $this TAB 2553 2554 _createLabel $canvas $tagList 2555 2556 # first get the label width and height 2557 _calcLabelDim $_gLabel 2558 2559 set bottom [expr {$_top + $_labelHeight}] 2560 2561 set angleOffset [expr {$_labelHeight * $_tan($angle)}] 2562 2563 set outerLeft $_left 2564 set outerRight \ 2565 [expr {$outerLeft + $angleOffset + $_labelWidth + $angleOffset}] 2566 set innerLeft [expr {$outerLeft + $angleOffset}] 2567 set innerRight [expr {$outerLeft + $angleOffset + $_labelWidth}] 2568 2569 # tab area... gets filled either white or selected 2570 set _gRegion [$canvas create polygon \ 2571 $outerLeft [expr {$_top + 1}] \ 2572 $innerLeft [expr {$bottom - $bevelamount}]\ 2573 [expr {$innerLeft + $bevelamount}] $bottom \ 2574 [expr {$innerRight - $bevelamount}] $bottom \ 2575 $innerRight [expr {$bottom - $bevelamount}]\ 2576 $outerRight [expr {$_top + 1}] \ 2577 $outerLeft [expr {$_top + 1}] \ 2578 -tags $tagList \ 2579 ] 2580 2581 2582 # lighter shadow (left edge) 2583 set _gLightShadow [$canvas create line \ 2584 [expr {$outerLeft+1}] $_top \ 2585 [expr {$innerLeft+1}] [expr {$bottom-$bevelamount}] \ 2586 -tags $tagList \ 2587 ] 2588 2589 # darker shadow (bottom and right edges) 2590 set _gDarkShadow [$canvas create line \ 2591 [expr {$innerLeft+1}] [expr {$bottom-$bevelamount}] \ 2592 [expr {$innerLeft+$bevelamount}] [expr {$bottom-1}] \ 2593 [expr {$innerRight-$bevelamount}] [expr {$bottom-1}] \ 2594 [expr {$innerRight-1}] [expr {$bottom-$bevelamount}] \ 2595 [expr {$outerRight-1}] [expr {$_top + 1}] \ 2596 -tags $tagList \ 2597 ] 2598 # outline of tab 2599 set _gBlackOutline [$canvas create line \ 2600 $outerLeft [expr {$_top + 1}] \ 2601 $innerLeft [expr {$bottom -$bevelamount}]\ 2602 [expr {$innerLeft + $bevelamount}] $bottom \ 2603 [expr {$innerRight - $bevelamount}] $bottom \ 2604 $innerRight [expr {$bottom - $bevelamount}]\ 2605 $outerRight [expr {$_top + 1}] \ 2606 -tags $tagList \ 2607 ] 2608 2609 # top of tab... to make it closed off 2610 set _gTopLine [$canvas create line \ 2611 $outerLeft [expr {$_top + 1}] \ 2612 $outerRight [expr {$_top + 1}] \ 2613 -tags $tagList \ 2614 ] 2615 2616 # top of tab... to make it closed off 2617 set _gTopLineShadow [$canvas create line \ 2618 $outerLeft $_top \ 2619 $outerRight $_top \ 2620 -tags $tagList \ 2621 ] 2622 2623 $canvas coords $_gLabel [expr {$innerLeft + $_labelXOrigin}] \ 2624 [expr {$_top + $_labelYOrigin}] 2625 2626 if { $image != {} || $bitmap != {} } { 2627 $canvas itemconfigure $_gLabel -anchor $anchor 2628 } else { 2629 $canvas itemconfigure $_gLabel -anchor $anchor -justify $_just 2630 } 2631 $canvas raise $_gLabel $_gRegion 2632 2633 2634 set _offset [expr {$innerRight - $outerLeft}] 2635 2636 # width 2637 set _majorDim [expr {$outerRight - $outerLeft}] 2638 2639 # height 2640 set _minorDim [expr {$bottom - $_top}] 2641 2642 set _right $outerRight 2643 set _bottom $bottom 2644 2645 # draw in correct state... 2646 if { $_selected } { 2647 select 2648 } else { 2649 deselect 2650 } 2651} 2652 2653# ---------------------------------------------------------------------- 2654# PRIVATE METHOD: _calcLabelDim 2655# 2656# Calculate the width and height of the label bbox of labelItem 2657# can be either text or bitmap (in future also an image) 2658# 2659# There are two ways to calculate the label bbox. 2660# 2661# First, if the $_width and/or $_height is specified, we will use 2662# it to determine that dimension(s) width and/or height. For 2663# a width/height of 0 we use the labels bbox to 2664# give us a base width/height. 2665# Then we add in the padx/pady to determine final bounds. 2666# 2667# Uses the following option or option derived variables: 2668# -padx ($_padX - converted to pixels) 2669# -pady ($_padY - converted to pixels) 2670# -anchor ($anchor) 2671# -width ($_width) This is the width for inside tab (label area) 2672# -height ($_height) This is the width for inside tab (label area) 2673# 2674# Side Effects: 2675# _labelWidth will be set 2676# _labelHeight will be set 2677# _labelXOrigin will be set 2678# _labelYOrigin will be set 2679# ---------------------------------------------------------------------- 2680itcl::body iwidgets::Tab::_calcLabelDim {labelItem} { 2681 # ... calculate the label width and height 2682 set labelBBox [$_canvas bbox $labelItem] 2683 2684 if { $_width > 0 } { 2685 set _labelWidth [expr {$_width + ($_padX * 2)}] 2686 } else { 2687 set _labelWidth [expr { 2688 ([lindex $labelBBox 2] - [lindex $labelBBox 0]) + ($_padX * 2)}] 2689 } 2690 2691 if { $_height > 0 } { 2692 set _labelHeight [expr {$_height + ($_padY * 2)}] 2693 } else { 2694 set _labelHeight [expr { 2695 ([lindex $labelBBox 3] - [lindex $labelBBox 1]) + ($_padY * 2)}] 2696 } 2697 2698 # ... calculate the label anchor point 2699 set centerX [expr {$_labelWidth/2.0}] 2700 set centerY [expr {$_labelHeight/2.0 - 1}] 2701 2702 switch $anchor { 2703 n { 2704 set _labelXOrigin $centerX 2705 set _labelYOrigin $_padY 2706 set _just center 2707 } 2708 s { 2709 set _labelXOrigin $centerX 2710 set _labelYOrigin [expr {$_labelHeight - $_padY}] 2711 set _just center 2712 } 2713 e { 2714 set _labelXOrigin [expr {$_labelWidth - $_padX - 1}] 2715 set _labelYOrigin $centerY 2716 set _just right 2717 } 2718 w { 2719 set _labelXOrigin [expr {$_padX + 2}] 2720 set _labelYOrigin $centerY 2721 set _just left 2722 } 2723 c { 2724 set _labelXOrigin $centerX 2725 set _labelYOrigin $centerY 2726 set _just center 2727 } 2728 ne { 2729 set _labelXOrigin [expr {$_labelWidth - $_padX - 1}] 2730 set _labelYOrigin $_padY 2731 set _just right 2732 } 2733 nw { 2734 set _labelXOrigin [expr {$_padX + 2}] 2735 set _labelYOrigin $_padY 2736 set _just left 2737 } 2738 se { 2739 set _labelXOrigin [expr {$_labelWidth - $_padX - 1}] 2740 set _labelYOrigin [expr {$_labelHeight - $_padY}] 2741 set _just right 2742 } 2743 sw { 2744 set _labelXOrigin [expr {$_padX + 2}] 2745 set _labelYOrigin [expr {$_labelHeight - $_padY}] 2746 set _just left 2747 } 2748 default { 2749 error "bad anchor position: \ 2750 \"$tabpos\" must be n, ne, nw, s, sw, se, e, w, or center" 2751 } 2752 } 2753} 2754