OpenCores
URL https://opencores.org/ocsvn/or1k_old/or1k_old/trunk

Subversion Repositories or1k_old

[/] [or1k_old/] [tags/] [start/] [insight/] [itcl/] [iwidgets3.0.0/] [generic/] [tabset.itk] - Blame information for rev 1782

Details | Compare with Previous | View Log

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

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.