home *** CD-ROM | disk | FTP | other *** search
/ PC World 2005 June / PCWorld_2005-06_cd.bin / software / vyzkuste / firewally / firewally.exe / framework-2.3.exe / tabset.itk < prev    next >
Text File  |  2003-09-01  |  88KB  |  2,754 lines
  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. #
  53. option add *Tabset.width          0            widgetDefault
  54. option add *Tabset.height         0            widgetDefault
  55. option add *Tabset.equalTabs      true         widgetDefault
  56. option add *Tabset.tabPos         s            widgetDefault
  57. option add *Tabset.raiseSelect    false        widgetDefault
  58. option add *Tabset.start          4            widgetDefault
  59. option add *Tabset.margin         5            widgetDefault
  60. option add *Tabset.tabBorders     true         widgetDefault
  61. option add *Tabset.bevelAmount    0            widgetDefault
  62. option add *Tabset.padX           4            widgetDefault
  63. option add *Tabset.padY           4            widgetDefault
  64. option add *Tabset.gap            overlap      widgetDefault
  65. option add *Tabset.angle          20           widgetDefault
  66. option add *Tabset.font           fixed        widgetDefault
  67. option add *Tabset.state          normal       widgetDefault
  68. option add *Tabset.disabledForeground #a3a3a3  widgetDefault
  69. option add *Tabset.foreground     black        widgetDefault
  70. option add *Tabset.background     #d9d9d9      widgetDefault
  71. option add *Tabset.selectForeground black      widgetDefault
  72. option add *Tabset.selectBackground #ececec    widgetDefault
  73.  
  74. #
  75. # Usual options.
  76. #
  77. itk::usual Tabset {
  78.     keep -backdrop -background -cursor -disabledforeground -font -foreground \
  79.      -selectbackground -selectforeground
  80. }
  81.  
  82. # ------------------------------------------------------------------
  83. #                              TABSET
  84. # ------------------------------------------------------------------
  85. itcl::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. #
  175. proc ::iwidgets::tabset {pathName args} {
  176.     uplevel ::iwidgets::Tabset $pathName $args
  177. }
  178.  
  179. # ----------------------------------------------------------------------
  180. #                              CONSTRUCTOR
  181. # ----------------------------------------------------------------------
  182. itcl::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.  
  228. itcl::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. # ----------------------------------------------------------------------
  243. itcl::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. # ----------------------------------------------------------------------
  255. itcl::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. # ----------------------------------------------------------------------
  266. itcl::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. # ----------------------------------------------------------------------
  275. itcl::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. # ----------------------------------------------------------------------
  303. itcl::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. # ----------------------------------------------------------------------
  314. itcl::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. # ----------------------------------------------------------------------
  329. itcl::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. # ----------------------------------------------------------------------
  344. itcl::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. # ----------------------------------------------------------------------
  355. itcl::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. # ----------------------------------------------------------------------
  367. itcl::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. # ----------------------------------------------------------------------
  379. itcl::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. # ----------------------------------------------------------------------
  390. itcl::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. # ----------------------------------------------------------------------
  408. itcl::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. # ----------------------------------------------------------------------
  419. itcl::configbody iwidgets::Tabset::font {
  420.     if {$itk_option(-font) != {}} {
  421.     _tabConfigure -font $itk_option(-font)
  422.     }
  423. }
  424.  
  425. # ----------------------------------------------------------------------
  426. # OPTION -state
  427. # ----------------------------------------------------------------------
  428. itcl::configbody iwidgets::Tabset::state {
  429.     if {$itk_option(-state) != {}} {
  430.     _tabConfigure -state $itk_option(-state)
  431.     }
  432. }
  433.  
  434. # ----------------------------------------------------------------------
  435. # OPTION -disabledforeground
  436. # ----------------------------------------------------------------------
  437. itcl::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. # ----------------------------------------------------------------------
  449. itcl::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. # ----------------------------------------------------------------------
  458. itcl::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. # ----------------------------------------------------------------------
  472. itcl::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. # ----------------------------------------------------------------------
  481. itcl::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. # ----------------------------------------------------------------------
  493. itcl::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. # ----------------------------------------------------------------------
  507. itcl::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. # ----------------------------------------------------------------------
  519. itcl::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. # ----------------------------------------------------------------------
  539. itcl::body iwidgets::Tabset::configure {args} {
  540.     set result [eval itk::Archetype::configure $args]
  541.  
  542.     _configRelayout
  543.  
  544.     return $result
  545. }
  546.  
  547. itcl::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. # ----------------------------------------------------------------------
  563. itcl::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. # ----------------------------------------------------------------------
  613. itcl::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. # ----------------------------------------------------------------------
  623. itcl::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. # ----------------------------------------------------------------------
  660. itcl::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. # ----------------------------------------------------------------------
  681. itcl::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. # -------------------------------------------------------------
  706. itcl::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. # ----------------------------------------------------------------------
  776. itcl::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. # ----------------------------------------------------------------------
  793. itcl::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. # ----------------------------------------------------------------------
  827. itcl::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. # ----------------------------------------------------------------------
  837. itcl::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. # ----------------------------------------------------------------------
  853. itcl::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. # ----------------------------------------------------------------------
  931. itcl::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. # ----------------------------------------------------------------------
  981. itcl::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. # ----------------------------------------------------------------------
  1024. itcl::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. # ----------------------------------------------------------------------
  1041. itcl::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. # ----------------------------------------------------------------------
  1190. itcl::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. # ----------------------------------------------------------------------
  1259. itcl::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. # ----------------------------------------------------------------------
  1273. itcl::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. # ----------------------------------------------------------------------
  1304. itcl::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. # ----------------------------------------------------------------------
  1353. itcl::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. # ----------------------------------------------------------------------
  1369. itcl::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. # ----------------------------------------------------------------------
  1383. itcl::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. # ----------------------------------------------------------------------
  1405. itcl::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.  
  1424. itcl::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. # ----------------------------------------------------------------------
  1575. itcl::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. # ----------------------------------------------------------------------
  1591. itcl::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. # ----------------------------------------------------------------------
  1612. itcl::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. # ----------------------------------------------------------------------
  1623. itcl::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. # ----------------------------------------------------------------------
  1631. itcl::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. # ----------------------------------------------------------------------
  1641. itcl::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. # ----------------------------------------------------------------------
  1651. itcl::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. # ----------------------------------------------------------------------
  1660. itcl::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. # ----------------------------------------------------------------------
  1678. itcl::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. # ----------------------------------------------------------------------
  1696. itcl::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. # ----------------------------------------------------------------------
  1706. itcl::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. # ----------------------------------------------------------------------
  1718. itcl::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. # ----------------------------------------------------------------------
  1727. itcl::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. # ----------------------------------------------------------------------
  1737. itcl::configbody iwidgets::Tab::pady {
  1738.     set _configTripped true
  1739.     set _padY [winfo pixels $_canvas $pady]
  1740. }
  1741.  
  1742. # ----------------------------------------------------------------------
  1743. # OPTION -selectbackground
  1744. # ----------------------------------------------------------------------
  1745. itcl::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. # ----------------------------------------------------------------------
  1761. itcl::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. # ----------------------------------------------------------------------
  1774. itcl::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. # ----------------------------------------------------------------------
  1787. itcl::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. # ----------------------------------------------------------------------
  1802. itcl::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. # ----------------------------------------------------------------------
  1816. itcl::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. # ----------------------------------------------------------------------
  1829. itcl::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. # ----------------------------------------------------------------------
  1842. itcl::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. # ----------------------------------------------------------------------
  1854. itcl::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. # ----------------------------------------------------------------------
  1868. itcl::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. # ----------------------------------------------------------------------
  1879. itcl::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. # ----------------------------------------------------------------------
  1907. itcl::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. # ----------------------------------------------------------------------
  1915. itcl::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. # ----------------------------------------------------------------------
  1933. itcl::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. # ----------------------------------------------------------------------
  1943. itcl::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. # ----------------------------------------------------------------------
  1953. itcl::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. # ----------------------------------------------------------------------
  1963. itcl::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. # ----------------------------------------------------------------------
  1974. itcl::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. # ----------------------------------------------------------------------
  1985. itcl::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. # ----------------------------------------------------------------------
  2001. itcl::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. # ----------------------------------------------------------------------
  2016. itcl::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. # ----------------------------------------------------------------------
  2031. itcl::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. # ----------------------------------------------------------------------
  2081. itcl::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. # ----------------------------------------------------------------------
  2137. itcl::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. # ----------------------------------------------------------------------
  2161. itcl::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. # ----------------------------------------------------------------------
  2192. itcl::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. # ----------------------------------------------------------------------
  2315. itcl::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. # ----------------------------------------------------------------------
  2434. itcl::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. # ----------------------------------------------------------------------
  2547. itcl::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. # ----------------------------------------------------------------------
  2680. itcl::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.