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