You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
2754 lines
86 KiB
Plaintext
2754 lines
86 KiB
Plaintext
#
|
|
# Tabset Widget and the Tab Class
|
|
# ----------------------------------------------------------------------
|
|
# A Tabset is a widget that contains a set of Tab buttons.
|
|
# It displays these tabs in a row or column depending on it tabpos.
|
|
# When a tab is clicked on, it becomes the only tab in the tab set that
|
|
# is selected. All other tabs are deselected. The Tcl command prefix
|
|
# associated with this tab (through the command tab configure option)
|
|
# is invoked with the tab index number appended to its argument list.
|
|
# This allows the Tabset to control another widget such as a Notebook.
|
|
#
|
|
# A Tab class is an [incr Tcl] class that displays either an image,
|
|
# bitmap, or label in a graphic object on a canvas. This graphic object
|
|
# can have a wide variety of appearances depending on the options set.
|
|
#
|
|
# WISH LIST:
|
|
# This section lists possible future enhancements.
|
|
#
|
|
# 1) When too many tabs appear, a small scrollbar should appear to
|
|
# move the tabs over.
|
|
#
|
|
# ----------------------------------------------------------------------
|
|
# AUTHOR: Bill W. Scott EMAIL: bscott@spd.dsccc.com
|
|
#
|
|
# @(#) $Id: tabset.itk,v 1.7 2002/02/25 04:47:17 mgbacke Exp $
|
|
# ----------------------------------------------------------------------
|
|
# Copyright (c) 1995 DSC Technologies Corporation
|
|
# ======================================================================
|
|
# Permission to use, copy, modify, distribute and license this software
|
|
# and its documentation for any purpose, and without fee or written
|
|
# agreement with DSC, is hereby granted, provided that the above copyright
|
|
# notice appears in all copies and that both the copyright notice and
|
|
# warranty disclaimer below appear in supporting documentation, and that
|
|
# the names of DSC Technologies Corporation or DSC Communications
|
|
# Corporation not be used in advertising or publicity pertaining to the
|
|
# software without specific, written prior permission.
|
|
#
|
|
# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
|
|
# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
|
|
# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
|
|
# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
|
|
# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
|
|
# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
|
|
# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
|
|
# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
|
|
# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
|
|
# SOFTWARE.
|
|
# ======================================================================
|
|
|
|
#
|
|
# Default resources.
|
|
#
|
|
option add *Tabset.width 0 widgetDefault
|
|
option add *Tabset.height 0 widgetDefault
|
|
option add *Tabset.equalTabs true widgetDefault
|
|
option add *Tabset.tabPos s widgetDefault
|
|
option add *Tabset.raiseSelect false widgetDefault
|
|
option add *Tabset.start 4 widgetDefault
|
|
option add *Tabset.margin 5 widgetDefault
|
|
option add *Tabset.tabBorders true widgetDefault
|
|
option add *Tabset.bevelAmount 0 widgetDefault
|
|
option add *Tabset.padX 4 widgetDefault
|
|
option add *Tabset.padY 4 widgetDefault
|
|
option add *Tabset.gap overlap widgetDefault
|
|
option add *Tabset.angle 20 widgetDefault
|
|
option add *Tabset.font fixed widgetDefault
|
|
option add *Tabset.state normal widgetDefault
|
|
option add *Tabset.disabledForeground #a3a3a3 widgetDefault
|
|
option add *Tabset.foreground black widgetDefault
|
|
option add *Tabset.background #d9d9d9 widgetDefault
|
|
option add *Tabset.selectForeground black widgetDefault
|
|
option add *Tabset.selectBackground #ececec widgetDefault
|
|
|
|
#
|
|
# Usual options.
|
|
#
|
|
itk::usual Tabset {
|
|
keep -backdrop -background -cursor -disabledforeground -font -foreground \
|
|
-selectbackground -selectforeground
|
|
}
|
|
|
|
# ------------------------------------------------------------------
|
|
# TABSET
|
|
# ------------------------------------------------------------------
|
|
itcl::class iwidgets::Tabset {
|
|
inherit itk::Widget
|
|
|
|
constructor {args} {}
|
|
destructor {}
|
|
|
|
itk_option define -width width Width 0
|
|
itk_option define -equaltabs equalTabs EqualTabs true
|
|
itk_option define -height height Height 0
|
|
itk_option define -tabpos tabPos TabPos s
|
|
itk_option define -raiseselect raiseSelect RaiseSelect false
|
|
itk_option define -start start Start 4
|
|
itk_option define -margin margin Margin 5
|
|
itk_option define -tabborders tabBorders TabBorders true
|
|
itk_option define -bevelamount bevelAmount BevelAmount 0
|
|
itk_option define -padx padX PadX 4
|
|
itk_option define -pady padY PadY 4
|
|
itk_option define -gap gap Gap overlap
|
|
itk_option define -angle angle Angle 20
|
|
itk_option define -font font Font fixed
|
|
itk_option define -state state State normal
|
|
itk_option define \
|
|
-disabledforeground disabledForeground DisabledForeground #a3a3a3
|
|
itk_option define -foreground foreground Foreground black
|
|
itk_option define -background background Background #d9d9d9
|
|
itk_option define -selectforeground selectForeground Background black
|
|
itk_option define -backdrop backdrop Backdrop white
|
|
itk_option define -selectbackground selectBackground Foreground #ececec
|
|
itk_option define -command command Command {}
|
|
|
|
public method configure {args}
|
|
public method add {args}
|
|
public method delete {args}
|
|
public method index {index}
|
|
public method insert {index args}
|
|
public method prev {}
|
|
public method next {}
|
|
public method select {index}
|
|
public method tabcget {index args}
|
|
public method tabconfigure {index args}
|
|
public method bbox {}
|
|
|
|
protected method _selectName {tabName}
|
|
|
|
private method _createTab {args}
|
|
private method _deleteTabs {fromTab toTab}
|
|
private method _index {pathList index select}
|
|
private method _tabConfigure {args}
|
|
private method _relayoutTabs {}
|
|
private method _drawBevelBorder {}
|
|
private method _calcNextTabOffset {tabName}
|
|
private method _tabBounds {}
|
|
private method _recalcCanvasGeom {}
|
|
private method _canvasReconfigure {width height}
|
|
private method _startMove {x y}
|
|
private method _moveTabs {x y}
|
|
private method _endMove {x y}
|
|
private method _configRelayout {}
|
|
|
|
private variable _width 0 ;# Width of the canvas in screen units
|
|
private variable _height 0 ;# Height of the canvas in screen units
|
|
private variable _selectedTop 0 ;# top edge of tab + a margin
|
|
private variable _deselectedTop 0 ;# top edge of tab + a margin&raiseamt
|
|
private variable _selectedLeft 0 ;# left edge of tab + a margin
|
|
private variable _deselectedLeft 0 ;# left edge of tab + a margin&raiseamt
|
|
private variable _tabs {} ;# our internal list of tabs
|
|
private variable _currTab -1 ;# numerical index # of selected tab
|
|
private variable _uniqueID 0 ;# used to create unique names
|
|
private variable _cmdStr {} ;# holds value of itk_option(-command)
|
|
;# do not know why I need this!
|
|
private variable _canvasWidth 0 ;# set by canvasReconfigure, is can wid
|
|
private variable _canvasHeight 0 ;# set by canvasReconfigure, is can hgt
|
|
|
|
private variable _anchorX 0 ;# used by mouse scrolling methods
|
|
private variable _anchorY 0 ;# used by mouse scrolling methods
|
|
|
|
private variable _margin 0 ;# -margin in screen units
|
|
private variable _start 0 ;# -start in screen units
|
|
private variable _gap overlap ;# -gap in screen units
|
|
|
|
private variable _relayout false ;# flag tripped to tell whether to
|
|
;# relayout tabs after the configure
|
|
private variable _skipRelayout false ;# flag that tells whether to skip
|
|
;# relayouting out the tabs. used by
|
|
;# _endMove.
|
|
}
|
|
|
|
#
|
|
# Provide a lowercase access method for the Tabset class
|
|
#
|
|
proc ::iwidgets::tabset {pathName args} {
|
|
uplevel ::iwidgets::Tabset $pathName $args
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# CONSTRUCTOR
|
|
# ----------------------------------------------------------------------
|
|
itcl::body iwidgets::Tabset::constructor {args} {
|
|
global tcl_platform
|
|
|
|
#
|
|
# Create the canvas that holds the tabs
|
|
#
|
|
itk_component add canvas {
|
|
canvas $itk_interior.canvas -highlightthickness 0
|
|
} {
|
|
keep -cursor -width -height
|
|
}
|
|
pack $itk_component(canvas) -fill both -expand yes -anchor nw
|
|
|
|
# ... This gives us a chance to redraw our bevel borders, etc when
|
|
# the size of our canvas changes...
|
|
bind $itk_component(canvas) <Configure> \
|
|
[itcl::code $this _canvasReconfigure %w %h]
|
|
bind $itk_component(canvas) <Map> \
|
|
[itcl::code $this _relayoutTabs]
|
|
|
|
|
|
# ... Allow button 2 scrolling as in label widget.
|
|
if {$tcl_platform(os) != "HP-UX"} {
|
|
bind $itk_component(canvas) <2> \
|
|
[itcl::code $this _startMove %x %y]
|
|
bind $itk_component(canvas) <B2-Motion> \
|
|
[itcl::code $this _moveTabs %x %y]
|
|
bind $itk_component(canvas) <ButtonRelease-2> \
|
|
[itcl::code $this _endMove %x %y]
|
|
}
|
|
|
|
# @@@
|
|
# @@@ Is there a better way?
|
|
# @@@
|
|
|
|
bind $itk_component(hull) <Tab> [itcl::code $this next]
|
|
bind $itk_component(hull) <Shift-Tab> [itcl::code $this prev]
|
|
|
|
eval itk_initialize $args
|
|
|
|
_configRelayout
|
|
|
|
_recalcCanvasGeom
|
|
|
|
}
|
|
|
|
itcl::body iwidgets::Tabset::destructor {} {
|
|
foreach tab $_tabs {
|
|
itcl::delete object $tab
|
|
}
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# OPTIONS
|
|
# ----------------------------------------------------------------------
|
|
|
|
# ----------------------------------------------------------------------
|
|
# OPTION -width
|
|
#
|
|
# Sets the width explicitly for the canvas of the tabset
|
|
# ----------------------------------------------------------------------
|
|
itcl::configbody iwidgets::Tabset::width {
|
|
if {$itk_option(-width) != {}} {
|
|
}
|
|
set _width [winfo pixels $itk_interior $itk_option(-width)]
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# OPTION -equaltabs
|
|
#
|
|
# If set to true, causes horizontal tabs to be equal in
|
|
# in width and vertical tabs to equal in height.
|
|
# ----------------------------------------------------------------------
|
|
itcl::configbody iwidgets::Tabset::equaltabs {
|
|
if {$itk_option(-equaltabs) != {}} {
|
|
set _relayout true
|
|
}
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# OPTION -height
|
|
#
|
|
# Sets the height explicitly for the canvas of the tabset
|
|
# ----------------------------------------------------------------------
|
|
itcl::configbody iwidgets::Tabset::height {
|
|
set _height [winfo pixels $itk_interior $itk_option(-height)]
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# OPTION -tabpos
|
|
#
|
|
# Sets the tab position of tabs, n, s, e, w
|
|
# ----------------------------------------------------------------------
|
|
itcl::configbody iwidgets::Tabset::tabpos {
|
|
if {$itk_option(-tabpos) != {}} {
|
|
switch $itk_option(-tabpos) {
|
|
n {
|
|
_tabConfigure -invert true -orient horizontal
|
|
}
|
|
s {
|
|
_tabConfigure -invert false -orient horizontal
|
|
}
|
|
w {
|
|
_tabConfigure -invert false -orient vertical
|
|
}
|
|
e {
|
|
_tabConfigure -invert true -orient vertical
|
|
}
|
|
default {
|
|
error "bad anchor position\
|
|
\"$itk_option(-tabpos)\" must be n, s, e, or w"
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# OPTION -raiseselect
|
|
#
|
|
# Sets whether to raise selected tabs slightly
|
|
# ----------------------------------------------------------------------
|
|
itcl::configbody iwidgets::Tabset::raiseselect {
|
|
if {$itk_option(-raiseselect) != {}} {
|
|
set _relayout true
|
|
}
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# OPTION -start
|
|
#
|
|
# Sets the offset to start of tab set
|
|
# ----------------------------------------------------------------------
|
|
itcl::configbody iwidgets::Tabset::start {
|
|
if {$itk_option(-start) != {}} {
|
|
set _start [winfo pixels $itk_interior $itk_option(-start)]
|
|
set _relayout true
|
|
} else {
|
|
set _start 4
|
|
}
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# OPTION -margin
|
|
#
|
|
# Sets the margin used above n tabs, below s tabs, left of e
|
|
# tabs, right of w tabs
|
|
# ----------------------------------------------------------------------
|
|
itcl::configbody iwidgets::Tabset::margin {
|
|
if {$itk_option(-margin) != {}} {
|
|
set _margin [winfo pixels $itk_interior $itk_option(-margin)]
|
|
set _relayout true
|
|
} else {
|
|
set _margin 5
|
|
}
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# OPTION -tabborders
|
|
#
|
|
# Boolean that specifies whether to draw the borders of
|
|
# the unselected tabs (tabs in background)
|
|
# ----------------------------------------------------------------------
|
|
itcl::configbody iwidgets::Tabset::tabborders {
|
|
if {$itk_option(-tabborders) != {}} {
|
|
_tabConfigure -tabborders $itk_option(-tabborders)
|
|
}
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# OPTION -bevelamount
|
|
#
|
|
# Specifies pixel size of tab corners. 0 means no corners.
|
|
# ----------------------------------------------------------------------
|
|
itcl::configbody iwidgets::Tabset::bevelamount {
|
|
if {$itk_option(-bevelamount) != {}} {
|
|
_tabConfigure -bevelamount $itk_option(-bevelamount)
|
|
}
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# OPTION -padx
|
|
#
|
|
# Sets the padding in each tab to the left and right of label
|
|
# I don't convert for fpixels, since Tab does it for me.
|
|
# ----------------------------------------------------------------------
|
|
itcl::configbody iwidgets::Tabset::padx {
|
|
if {$itk_option(-padx) != {}} {
|
|
_tabConfigure -padx $itk_option(-padx)
|
|
}
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# OPTION -pady
|
|
#
|
|
# Sets the padding in each tab to the left and right of label
|
|
# I don't convert for fpixels, since Tab does it for me.
|
|
# ----------------------------------------------------------------------
|
|
itcl::configbody iwidgets::Tabset::pady {
|
|
if {$itk_option(-pady) != {}} {
|
|
_tabConfigure -pady $itk_option(-pady)
|
|
}
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# OPTION -gap
|
|
#
|
|
# Sets the amount of spacing between tabs in pixels
|
|
# ----------------------------------------------------------------------
|
|
itcl::configbody iwidgets::Tabset::gap {
|
|
if {$itk_option(-gap) != {}} {
|
|
if {$itk_option(-gap) != "overlap"} {
|
|
set _gap [winfo pixels $itk_interior $itk_option(-gap)]
|
|
} else {
|
|
set _gap overlap
|
|
}
|
|
set _relayout true
|
|
} else {
|
|
set _gap overlap
|
|
}
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# OPTION -angle
|
|
#
|
|
# Sets the angle of the tab's sides
|
|
# ----------------------------------------------------------------------
|
|
itcl::configbody iwidgets::Tabset::angle {
|
|
if {$itk_option(-angle) != {}} {
|
|
_tabConfigure -angle $itk_option(-angle)
|
|
}
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# OPTION -font
|
|
#
|
|
# Sets the font of the tab (SELECTED and UNSELECTED)
|
|
# ----------------------------------------------------------------------
|
|
itcl::configbody iwidgets::Tabset::font {
|
|
if {$itk_option(-font) != {}} {
|
|
_tabConfigure -font $itk_option(-font)
|
|
}
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# OPTION -state
|
|
# ----------------------------------------------------------------------
|
|
itcl::configbody iwidgets::Tabset::state {
|
|
if {$itk_option(-state) != {}} {
|
|
_tabConfigure -state $itk_option(-state)
|
|
}
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# OPTION -disabledforeground
|
|
# ----------------------------------------------------------------------
|
|
itcl::configbody iwidgets::Tabset::disabledforeground {
|
|
if {$itk_option(-disabledforeground) != {}} {
|
|
_tabConfigure \
|
|
-disabledforeground $itk_option(-disabledforeground)
|
|
}
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# OPTION -foreground
|
|
#
|
|
# Sets the foreground label color of UNSELECTED tabs
|
|
# ----------------------------------------------------------------------
|
|
itcl::configbody iwidgets::Tabset::foreground {
|
|
_tabConfigure -foreground $itk_option(-foreground)
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# OPTION -background
|
|
#
|
|
# Sets the background color of UNSELECTED tabs
|
|
# ----------------------------------------------------------------------
|
|
itcl::configbody iwidgets::Tabset::background {
|
|
if {$itk_option(-background) != {}} {
|
|
_tabConfigure -background $itk_option(-background)
|
|
} else {
|
|
_tabConfigure -background \
|
|
[$itk_component(canvas) cget -background]
|
|
}
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# OPTION -selectforeground
|
|
#
|
|
# Sets the foreground label color of SELECTED tabs
|
|
# ----------------------------------------------------------------------
|
|
itcl::configbody iwidgets::Tabset::selectforeground {
|
|
_tabConfigure -selectforeground $itk_option(-selectforeground)
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# OPTION -backdrop
|
|
#
|
|
# Sets the background color of the Tabset backdrop (behind the tabs)
|
|
# ----------------------------------------------------------------------
|
|
itcl::configbody iwidgets::Tabset::backdrop {
|
|
if {$itk_option(-backdrop) != {}} {
|
|
$itk_component(canvas) configure \
|
|
-background $itk_option(-backdrop)
|
|
}
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# OPTION -selectbackground
|
|
#
|
|
# Sets the background color of SELECTED tabs
|
|
# ----------------------------------------------------------------------
|
|
itcl::configbody iwidgets::Tabset::selectbackground {
|
|
if {$itk_option(-selectbackground) != {}} {
|
|
} else {
|
|
#set _selectBackground \
|
|
[$itk_component(canvas) cget -background]
|
|
}
|
|
_tabConfigure -selectbackground $itk_option(-selectbackground)
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# OPTION -command
|
|
#
|
|
# The command to invoke when a tab is hit.
|
|
# ----------------------------------------------------------------------
|
|
itcl::configbody iwidgets::Tabset::command {
|
|
if {$itk_option(-command) != {}} {
|
|
set _cmdStr $itk_option(-command)
|
|
}
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# METHOD: add ?option value...?
|
|
#
|
|
# Creates a tab and appends it to the list of tabs.
|
|
# processes tabconfigure for the tab added.
|
|
# ----------------------------------------------------------------------
|
|
itcl::body iwidgets::Tabset::add {args} {
|
|
set tabName [eval _createTab $args]
|
|
lappend _tabs $tabName
|
|
|
|
_relayoutTabs
|
|
|
|
return $tabName
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# METHOD: configure ?option? ?value option value...?
|
|
#
|
|
# Acts as an addendum to the itk::Widget::configure method.
|
|
#
|
|
# Checks the _relayout flag to see if after configures are done
|
|
# we need to relayout the tabs.
|
|
#
|
|
# _skipRelayout is set in the MB2 scroll methods, to avoid constant
|
|
# relayout of tabs while dragging the mouse.
|
|
# ----------------------------------------------------------------------
|
|
itcl::body iwidgets::Tabset::configure {args} {
|
|
set result [eval itk::Archetype::configure $args]
|
|
|
|
_configRelayout
|
|
|
|
return $result
|
|
}
|
|
|
|
itcl::body iwidgets::Tabset::_configRelayout {} {
|
|
# then relayout tabs if necessary
|
|
if { $_relayout } {
|
|
if { $_skipRelayout } {
|
|
} else {
|
|
_relayoutTabs
|
|
}
|
|
set _relayout false
|
|
}
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# METHOD: delete index1 ?index2?
|
|
#
|
|
# Deletes a tab or range of tabs from the tabset
|
|
# ----------------------------------------------------------------------
|
|
itcl::body iwidgets::Tabset::delete {args} {
|
|
if { $_tabs == {} } {
|
|
error "can't delete tabs,\
|
|
no tabs in the tabset named $itk_component(hull)"
|
|
}
|
|
|
|
set len [llength $args]
|
|
switch $len {
|
|
0 {
|
|
error "wrong # args: should be\
|
|
\"$itk_component(hull) delete index1 ?index2?\""
|
|
}
|
|
|
|
1 {
|
|
set fromTab [index [lindex $args 0]]
|
|
if { $fromTab == -1 } {
|
|
error "bad value for index1:\
|
|
[lindex $args 0] in call to delete"
|
|
}
|
|
set toTab $fromTab
|
|
_deleteTabs $fromTab $toTab
|
|
}
|
|
|
|
2 {
|
|
set fromTab [index [lindex $args 0]]
|
|
if { $fromTab == -1 } {
|
|
error "bad value for index1:\
|
|
[lindex $args 0] in call to delete"
|
|
}
|
|
set toTab [index [lindex $args 1]]
|
|
|
|
if { $toTab == -1 } {
|
|
error "bad value for index2:\
|
|
[lindex $args 1] in call to delete"
|
|
}
|
|
_deleteTabs $fromTab $toTab
|
|
}
|
|
|
|
default {
|
|
error "wrong # args: should be\
|
|
\"$itk_component(hull) delete index1 ?index2?\""
|
|
}
|
|
}
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# METHOD: index index
|
|
#
|
|
# Given an index identifier returns the numeric index of the tab
|
|
# ----------------------------------------------------------------------
|
|
itcl::body iwidgets::Tabset::index {index} {
|
|
return [_index $_tabs $index $_currTab]
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# METHOD: insert index ?option value...?
|
|
#
|
|
# Inserts a tab before a index. The before tab may
|
|
# be specified as a label or a tab position.
|
|
# ----------------------------------------------------------------------
|
|
itcl::body iwidgets::Tabset::insert {index args} {
|
|
if { $_tabs == {} } {
|
|
error "no tab to insert before,\
|
|
tabset '$itk_component(hull)' is empty"
|
|
}
|
|
|
|
# get the tab
|
|
set tab [index $index]
|
|
|
|
# catch bad value for before tab.
|
|
if { $tab < 0 || $tab >= [llength $_tabs] } {
|
|
error "bad value $tab for index:\
|
|
should be between 0 and [expr {[llength $_tabs] - 1}]"
|
|
}
|
|
|
|
# create the new tab and get its name...
|
|
set tabName [eval _createTab $args]
|
|
|
|
# grab the name of the tab currently selected. (to keep in sync)
|
|
set currTabName [lindex $_tabs $_currTab]
|
|
|
|
# insert tabName before $tab
|
|
set _tabs [linsert $_tabs $tab $tabName]
|
|
|
|
# keep the _currTab in sync with the insert.
|
|
set _currTab [lsearch -exact $_tabs $currTabName]
|
|
|
|
_relayoutTabs
|
|
|
|
return $tabName
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# METHOD: prev
|
|
#
|
|
# Selects the prev tab. Wraps at first back to last tab.
|
|
# ----------------------------------------------------------------------
|
|
itcl::body iwidgets::Tabset::prev {} {
|
|
if { $_tabs == {} } {
|
|
error "can't goto previous tab,\
|
|
no tabs in the tabset: $itk_component(hull)"
|
|
}
|
|
|
|
# bump to the previous tab and wrap if necessary
|
|
set prev [expr {$_currTab - 1}]
|
|
if { $prev < 0 } {
|
|
set prev [expr {[llength $_tabs] - 1}]
|
|
}
|
|
|
|
select $prev
|
|
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# METHOD: next
|
|
#
|
|
# Selects the next tab. Wraps at last back to first tab.
|
|
# ----------------------------------------------------------------------
|
|
itcl::body iwidgets::Tabset::next {} {
|
|
if { $_tabs == {} } {
|
|
error "can't goto next tab,\
|
|
no tabs in the tabset: $itk_component(hull)"
|
|
}
|
|
|
|
# bump to the next tab and wrap if necessary
|
|
set next [expr {$_currTab + 1}]
|
|
if { $next >= [llength $_tabs] } {
|
|
set next 0
|
|
}
|
|
|
|
select $next
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# METHOD: select index
|
|
#
|
|
# Select a tab by index
|
|
#
|
|
# Lowers the last _currTab if it existed.
|
|
# Then raises the new one if it exists.
|
|
#
|
|
# Returns numeric index of selection, -1 if failed.
|
|
# -------------------------------------------------------------
|
|
itcl::body iwidgets::Tabset::select {index} {
|
|
if { $_tabs == {} } {
|
|
error "can't activate a tab,\
|
|
no tabs in the tabset: $itk_component(hull)"
|
|
}
|
|
|
|
# if there is not current selection just ignore trying this selection
|
|
if { $index == "select" && $_currTab == -1 } {
|
|
return -1
|
|
}
|
|
|
|
# is selection request in range ?
|
|
set reqTab [index $index]
|
|
if { $reqTab == -1 } {
|
|
error "bad value $index for index:\
|
|
should be from 0 to [expr {[llength $_tabs] - 1}]"
|
|
}
|
|
|
|
# If already selected then ignore and return...
|
|
if { $reqTab == $_currTab } {
|
|
return $reqTab
|
|
}
|
|
|
|
# ---- Deselect
|
|
if { $_currTab != -1 } {
|
|
set currTabName [lindex $_tabs $_currTab]
|
|
$currTabName deselect
|
|
|
|
# handle different orientations...
|
|
if { $itk_option(-tabpos) == "n" || $itk_option(-tabpos) == "s"} {
|
|
$currTabName configure -top $_deselectedTop
|
|
} else {
|
|
$currTabName configure -left $_deselectedLeft
|
|
}
|
|
}
|
|
|
|
# get the stacking order correct...
|
|
foreach tab $_tabs {
|
|
$tab lower
|
|
}
|
|
|
|
# set this now so that the -command cmd can do an 'index select'
|
|
# to operate on this tab.
|
|
set _currTab $reqTab
|
|
|
|
# ---- Select
|
|
set reqTabName [lindex $_tabs $reqTab]
|
|
$reqTabName select
|
|
if { $itk_option(-tabpos) == "n" || $itk_option(-tabpos) == "s"} {
|
|
$reqTabName configure -top $_selectedTop
|
|
} else {
|
|
$reqTabName configure -left $_selectedLeft
|
|
}
|
|
|
|
set _currTab $reqTab
|
|
|
|
# invoke any user command string, appended with tab index number
|
|
if { $_cmdStr != {} } {
|
|
set newCmd $_cmdStr
|
|
eval [lappend newCmd $reqTab]
|
|
}
|
|
|
|
return $reqTab
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# METHOD: tabcget index ?option?
|
|
#
|
|
# Returns the value for the option setting of the tab at index $index.
|
|
# ----------------------------------------------------------------------
|
|
itcl::body iwidgets::Tabset::tabcget {index args} {
|
|
return [lindex [eval tabconfigure $index $args] 2]
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# METHOD: tabconfigure index ?option? ?value option value?
|
|
#
|
|
# tabconfigure index : returns configuration list
|
|
# tabconfigure index -option : returns option values
|
|
# tabconfigure index ?option value option value ...? sets options
|
|
# and returns empty string.
|
|
#
|
|
# Performs configure on a given tab denoted by index.
|
|
#
|
|
# Index may be a tab number or a pattern matching the label
|
|
# associated with a tab.
|
|
# ----------------------------------------------------------------------
|
|
itcl::body iwidgets::Tabset::tabconfigure {index args} {
|
|
# convert index to numeric
|
|
set tab [index $index]
|
|
|
|
if { $tab == -1 } {
|
|
error "bad index value:\
|
|
$index for $itk_component(hull) tabconfigure"
|
|
}
|
|
|
|
set tabName [lindex $_tabs $tab]
|
|
|
|
set len [llength $args]
|
|
switch $len {
|
|
0 {
|
|
return [eval $tabName configure]
|
|
}
|
|
1 {
|
|
return [eval $tabName configure $args]
|
|
}
|
|
default {
|
|
eval $tabName configure $args
|
|
_relayoutTabs
|
|
select select
|
|
}
|
|
}
|
|
return ""
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# METHOD: bbox
|
|
#
|
|
# calculates the bounding box that will completely enclose
|
|
# all the tabs.
|
|
# ----------------------------------------------------------------------
|
|
itcl::body iwidgets::Tabset::bbox {} {
|
|
return [_tabBounds]
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# PROTECTED METHOD: _selectName
|
|
#
|
|
# internal method to allow selection by internal tab name
|
|
# rather than index. This is used by the bind methods
|
|
# ----------------------------------------------------------------------
|
|
itcl::body iwidgets::Tabset::_selectName {tabName} {
|
|
# if the tab is disabled, then ignore this selection...
|
|
if { [$tabName cget -state] == "disabled" } {
|
|
return
|
|
}
|
|
|
|
set tab [lsearch -exact $_tabs $tabName]
|
|
select $tab
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# PRIVATE METHOD: _createTab
|
|
#
|
|
# Creates a tab, using unique tab naming, propagates background
|
|
# and keeps unique id up to date.
|
|
# ----------------------------------------------------------------------
|
|
itcl::body iwidgets::Tabset::_createTab {args} {
|
|
#
|
|
# create an internal name for the tab: tab0, tab1, etc.
|
|
# these are one-up numbers they do not
|
|
# correspond to the position the tab is located in.
|
|
#
|
|
set tabName $this-tab$_uniqueID
|
|
|
|
switch $itk_option(-tabpos) {
|
|
n {
|
|
set invert true
|
|
set orient horizontal
|
|
set x 0
|
|
set y [expr {$_margin + 1}]
|
|
}
|
|
s {
|
|
set invert false
|
|
set orient horizontal
|
|
set x 0
|
|
set y 0
|
|
}
|
|
w {
|
|
set invert false
|
|
set orient vertical
|
|
set x 0
|
|
set y 0
|
|
}
|
|
e {
|
|
set invert true
|
|
set orient vertical
|
|
set x [expr {$_margin + 1}]
|
|
set y 0
|
|
}
|
|
default {
|
|
error "bad anchor position\
|
|
\"$itk_option(-tabpos)\" must be n, s, e, or w"
|
|
}
|
|
}
|
|
|
|
eval iwidgets::Tab $tabName $itk_component(canvas) \
|
|
-left $x \
|
|
-top $y \
|
|
-font [list $itk_option(-font)] \
|
|
-background $itk_option(-background) \
|
|
-foreground $itk_option(-foreground) \
|
|
-selectforeground $itk_option(-selectforeground) \
|
|
-disabledforeground $itk_option(-disabledforeground) \
|
|
-selectbackground $itk_option(-selectbackground) \
|
|
-angle $itk_option(-angle) \
|
|
-padx $itk_option(-padx) \
|
|
-pady $itk_option(-pady) \
|
|
-bevelamount $itk_option(-bevelamount) \
|
|
-state $itk_option(-state) \
|
|
-tabborders $itk_option(-tabborders) \
|
|
-invert $invert \
|
|
-orient $orient \
|
|
$args
|
|
|
|
$tabName lower
|
|
|
|
$itk_component(canvas) \
|
|
bind $tabName <Button-1> [itcl::code $this _selectName $tabName]
|
|
|
|
incr _uniqueID
|
|
|
|
return $tabName
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# PRIVATE METHOD: _deleteTabs
|
|
#
|
|
# Deletes tabs from $fromTab to $toTab.
|
|
#
|
|
# Operates in two passes, destroys all the widgets
|
|
# Then removes the pathName from the tab list
|
|
#
|
|
# Also keeps the current selection in bounds.
|
|
# ----------------------------------------------------------------------
|
|
itcl::body iwidgets::Tabset::_deleteTabs {fromTab toTab} {
|
|
for { set tab $fromTab } { $tab <= $toTab } { incr tab } {
|
|
set tabName [lindex $_tabs $tab]
|
|
|
|
# unbind Button-1 from this window name
|
|
$itk_component(canvas) bind $tabName <Button-1> {}
|
|
|
|
# Destroy the Tab class...
|
|
itcl::delete object $tabName
|
|
}
|
|
|
|
# physically remove the tab
|
|
set _tabs [lreplace $_tabs $fromTab $toTab]
|
|
|
|
# If we deleted a selected tab set our selection to none
|
|
if { $_currTab >= $fromTab && $_currTab <= $toTab } {
|
|
set _currTab -1
|
|
_drawBevelBorder
|
|
}
|
|
|
|
# make sure _currTab stays in sync with new numbering...
|
|
if { $_tabs == {} } {
|
|
# if deleted only remaining tab,
|
|
# reset current tab to undefined
|
|
set _currTab -1
|
|
|
|
# or if the current tab was the last tab, it needs come back
|
|
} elseif { $_currTab >= [llength $_tabs] } {
|
|
incr _currTab -1
|
|
if { $_currTab < 0 } {
|
|
# but only to zero
|
|
set _currTab 0
|
|
}
|
|
}
|
|
|
|
_relayoutTabs
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# PRIVATE METHOD: _index
|
|
#
|
|
# pathList : list of path names to search thru if index is a label
|
|
# index : either number, 'select', 'end', or pattern
|
|
# select : current selection
|
|
#
|
|
# _index takes takes the value $index converts it to
|
|
# a numeric identifier. If the value is not already
|
|
# an integer it looks it up in the $pathList array.
|
|
# If it fails it returns -1
|
|
# ----------------------------------------------------------------------
|
|
itcl::body iwidgets::Tabset::_index {pathList index select} {
|
|
switch $index {
|
|
select {
|
|
set number $select
|
|
}
|
|
end {
|
|
set number [expr {[llength $pathList] -1}]
|
|
}
|
|
default {
|
|
# is it an number already?
|
|
if { [regexp {^[0-9]+$} $index] } {
|
|
set number $index
|
|
if { $number < 0 || $number >= [llength $pathList] } {
|
|
set number -1
|
|
}
|
|
|
|
# otherwise it is a label
|
|
} else {
|
|
# look thru the pathList of pathNames and
|
|
# get each label and compare with index.
|
|
# if we get a match then set number to postion in $pathList
|
|
# and break out.
|
|
# otherwise number is still -1
|
|
set i 0
|
|
set number -1
|
|
foreach pathName $pathList {
|
|
set label [$pathName cget -label]
|
|
if { $label == $index } {
|
|
set number $i
|
|
break
|
|
}
|
|
incr i
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
return $number
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# PRIVATE METHOD: _tabConfigure
|
|
# ----------------------------------------------------------------------
|
|
itcl::body iwidgets::Tabset::_tabConfigure {args} {
|
|
foreach tab $_tabs {
|
|
eval $tab configure $args
|
|
}
|
|
|
|
set _relayout true
|
|
|
|
if { $_tabs != {} } {
|
|
select select
|
|
}
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# PRIVATE METHOD: _relayoutTabs
|
|
#
|
|
# relays out the tabs with correct spacing...
|
|
# ----------------------------------------------------------------------
|
|
itcl::body iwidgets::Tabset::_relayoutTabs {} {
|
|
if { [llength $_tabs] == 0 || ![winfo viewable $itk_component(hull)]} {
|
|
return
|
|
}
|
|
|
|
# get the max width for fixed width tabs...
|
|
set maxWidth 0
|
|
foreach tab $_tabs {
|
|
set width [$tab labelwidth]
|
|
if { $width > $maxWidth } {
|
|
set maxWidth $width
|
|
}
|
|
}
|
|
|
|
# get the max height for fixed height tabs...
|
|
set maxHeight 0
|
|
foreach tab $_tabs {
|
|
set height [$tab labelheight]
|
|
if { $height > $maxHeight } {
|
|
set maxHeight $height
|
|
}
|
|
}
|
|
|
|
# get curr tab's name
|
|
set currTabName [lindex $_tabs $_currTab]
|
|
|
|
# Start with our margin offset in pixels...
|
|
set tabStart $_start
|
|
|
|
if { $itk_option(-raiseselect) } {
|
|
set raiseAmt 2
|
|
} else {
|
|
set raiseAmt 0
|
|
}
|
|
|
|
#
|
|
# Depending on the tab layout: n, s, e, or w place the tabs
|
|
# according to orientation, raise, margins, etc.
|
|
#
|
|
switch $itk_option(-tabpos) {
|
|
n {
|
|
set _selectedTop [expr {$_margin + 1}]
|
|
set _deselectedTop [expr {$_selectedTop + $raiseAmt}]
|
|
|
|
if { $itk_option(-equaltabs) } {
|
|
set tabWidth $maxWidth
|
|
} else {
|
|
set tabWidth 0
|
|
}
|
|
|
|
foreach tab $_tabs {
|
|
if { $tab == $currTabName } {
|
|
$tab configure -left $tabStart -top $_selectedTop \
|
|
-height $maxHeight -width $tabWidth -anchor c
|
|
} else {
|
|
$tab configure -left $tabStart -top $_deselectedTop \
|
|
-height $maxHeight -width $tabWidth -anchor c
|
|
}
|
|
set tabStart [expr {$tabStart + [_calcNextTabOffset $tab]}]
|
|
}
|
|
|
|
}
|
|
s {
|
|
set _selectedTop 0
|
|
set _deselectedTop [expr {$_selectedTop - $raiseAmt}]
|
|
|
|
if { $itk_option(-equaltabs) } {
|
|
set tabWidth $maxWidth
|
|
} else {
|
|
set tabWidth 0
|
|
}
|
|
|
|
foreach tab $_tabs {
|
|
if { $tab == $currTabName } {
|
|
$tab configure -left $tabStart -top $_selectedTop \
|
|
-height $maxHeight -width $tabWidth -anchor c
|
|
} else {
|
|
$tab configure -left $tabStart -top $_deselectedTop \
|
|
-height $maxHeight -width $tabWidth -anchor c
|
|
}
|
|
set tabStart [expr {$tabStart + [_calcNextTabOffset $tab]}]
|
|
}
|
|
|
|
}
|
|
w {
|
|
set _selectedLeft [expr {$_margin + 1}]
|
|
set _deselectedLeft [expr {$_selectedLeft + $raiseAmt}]
|
|
|
|
if { $itk_option(-equaltabs) } {
|
|
set tabHeight $maxHeight
|
|
} else {
|
|
set tabHeight 0
|
|
}
|
|
|
|
foreach tab $_tabs {
|
|
# selected
|
|
if { $tab == $currTabName } {
|
|
$tab configure -top $tabStart -left $_selectedLeft \
|
|
-height $tabHeight -width $maxWidth -anchor e
|
|
# deselected
|
|
} else {
|
|
$tab configure -top $tabStart -left $_deselectedLeft \
|
|
-height $tabHeight -width $maxWidth -anchor e
|
|
}
|
|
set tabStart [expr {$tabStart + [_calcNextTabOffset $tab]}]
|
|
}
|
|
|
|
}
|
|
e {
|
|
set _selectedLeft 0
|
|
set _deselectedLeft [expr {$_selectedLeft - $raiseAmt}]
|
|
|
|
if { $itk_option(-equaltabs) } {
|
|
set tabHeight $maxHeight
|
|
} else {
|
|
set tabHeight 0
|
|
}
|
|
|
|
foreach tab $_tabs {
|
|
# selected
|
|
if { $tab == $currTabName } {
|
|
$tab configure -top $tabStart -left $_selectedLeft \
|
|
-height $tabHeight -width $maxWidth -anchor w
|
|
# deselected
|
|
} else {
|
|
$tab configure -top $tabStart -left $_deselectedLeft \
|
|
-height $tabHeight -width $maxWidth -anchor w
|
|
}
|
|
set tabStart [expr {$tabStart + [_calcNextTabOffset $tab]}]
|
|
}
|
|
|
|
}
|
|
default {
|
|
error "bad anchor position\
|
|
\"$itk_option(-tabpos)\" must be n, s, e, or w"
|
|
}
|
|
}
|
|
|
|
# put border on & calc our new canvas size...
|
|
_drawBevelBorder
|
|
_recalcCanvasGeom
|
|
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# PRIVATE METHOD: _drawBevelBorder
|
|
#
|
|
# draws the bevel border along tab edge (below selected tab)
|
|
# ----------------------------------------------------------------------
|
|
itcl::body iwidgets::Tabset::_drawBevelBorder {} {
|
|
$itk_component(canvas) delete bevelBorder
|
|
|
|
switch $itk_option(-tabpos) {
|
|
n {
|
|
$itk_component(canvas) create line \
|
|
0 [expr {$_canvasHeight - 1}] \
|
|
$_canvasWidth [expr {$_canvasHeight - 1}] \
|
|
-fill [iwidgets::colors::topShadow $itk_option(-selectbackground)] \
|
|
-tags bevelBorder
|
|
$itk_component(canvas) create line \
|
|
0 $_canvasHeight \
|
|
$_canvasWidth $_canvasHeight \
|
|
-fill [iwidgets::colors::topShadow $itk_option(-selectbackground)] \
|
|
-tags bevelBorder
|
|
}
|
|
s {
|
|
$itk_component(canvas) create line \
|
|
0 0 \
|
|
$_canvasWidth 0 \
|
|
-fill [iwidgets::colors::bottomShadow $itk_option(-selectbackground)] \
|
|
-tags bevelBorder
|
|
$itk_component(canvas) create line \
|
|
0 1 \
|
|
$_canvasWidth 1 \
|
|
-fill black \
|
|
-tags bevelBorder
|
|
}
|
|
w {
|
|
$itk_component(canvas) create line \
|
|
$_canvasWidth 0 \
|
|
$_canvasWidth [expr {$_canvasHeight - 1}] \
|
|
-fill [iwidgets::colors::topShadow $itk_option(-selectbackground)] \
|
|
-tags bevelBorder
|
|
$itk_component(canvas) create line \
|
|
[expr {$_canvasWidth - 1}] 0 \
|
|
[expr {$_canvasWidth - 1}] [expr {$_canvasHeight - 1}] \
|
|
-fill [iwidgets::colors::topShadow $itk_option(-selectbackground)] \
|
|
-tags bevelBorder
|
|
|
|
}
|
|
e {
|
|
$itk_component(canvas) create line \
|
|
0 0 \
|
|
0 [expr {$_canvasHeight - 1}] \
|
|
-fill black \
|
|
-tags bevelBorder
|
|
$itk_component(canvas) create line \
|
|
1 0 \
|
|
1 [expr {$_canvasHeight - 1}] \
|
|
-fill [iwidgets::colors::bottomShadow $itk_option(-selectbackground)] \
|
|
-tags bevelBorder
|
|
|
|
}
|
|
}
|
|
|
|
$itk_component(canvas) raise bevelBorder
|
|
if { $_currTab != -1 } {
|
|
set currTabName [lindex $_tabs $_currTab]
|
|
$currTabName raise
|
|
}
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# PRIVATE METHOD: _calcNextTabOffset
|
|
#
|
|
# given $tabName, determines the offset in pixels to place
|
|
# the next tab's start edge at.
|
|
# ----------------------------------------------------------------------
|
|
itcl::body iwidgets::Tabset::_calcNextTabOffset {tabName} {
|
|
if { $_gap == "overlap" } {
|
|
return [$tabName offset]
|
|
} else {
|
|
return [expr {[$tabName majordim] + $_gap}]
|
|
}
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# PRIVATE METHOD: _tabBounds
|
|
#
|
|
# calculates the bounding box that will completely enclose
|
|
# all the tabs.
|
|
# ----------------------------------------------------------------------
|
|
itcl::body iwidgets::Tabset::_tabBounds {} {
|
|
set bbox { 100000 100000 -10000 -10000 }
|
|
foreach tab $_tabs {
|
|
set tabBBox [$tab bbox]
|
|
# if this left is less use it
|
|
if { [lindex $tabBBox 0] < [lindex $bbox 0] } {
|
|
set bbox [lreplace $bbox 0 0 [lindex $tabBBox 0]]
|
|
}
|
|
# if this top is greater use it
|
|
if { [lindex $tabBBox 1] < [lindex $bbox 1] } {
|
|
set bbox [lreplace $bbox 1 1 [lindex $tabBBox 1]]
|
|
}
|
|
# if this right is less use it
|
|
if { [lindex $tabBBox 2] > [lindex $bbox 2] } {
|
|
set bbox [lreplace $bbox 2 2 [lindex $tabBBox 2]]
|
|
}
|
|
# if this bottom is greater use it
|
|
if { [lindex $tabBBox 3] > [lindex $bbox 3] } {
|
|
set bbox [lreplace $bbox 3 3 [lindex $tabBBox 3]]
|
|
}
|
|
|
|
}
|
|
return $bbox
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# PRIVATE METHOD: _recalcCanvasGeom
|
|
#
|
|
# Based on size of tabs, recalculates the canvas geometry that
|
|
# will hold the tabs.
|
|
# ----------------------------------------------------------------------
|
|
itcl::body iwidgets::Tabset::_recalcCanvasGeom {} {
|
|
if { [llength $_tabs] == 0 } {
|
|
return
|
|
}
|
|
|
|
set bbox [_tabBounds]
|
|
|
|
set width [lindex [_tabBounds] 2]
|
|
set height [lindex [_tabBounds] 3]
|
|
|
|
# now we have the dimensions of all the tabs in the canvas.
|
|
|
|
|
|
switch $itk_option(-tabpos) {
|
|
n {
|
|
# height already includes margin
|
|
$itk_component(canvas) configure \
|
|
-width $width \
|
|
-height $height
|
|
}
|
|
s {
|
|
$itk_component(canvas) configure \
|
|
-width $width \
|
|
-height [expr {$height + $_margin}]
|
|
}
|
|
w {
|
|
# width already includes margin
|
|
$itk_component(canvas) configure \
|
|
-width $width \
|
|
-height [expr {$height + 1}]
|
|
}
|
|
e {
|
|
$itk_component(canvas) configure \
|
|
-width [expr {$width + $_margin}] \
|
|
-height [expr {$height + 1}]
|
|
}
|
|
default {
|
|
}
|
|
}
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# PRIVATE METHOD: _canvasReconfigure
|
|
#
|
|
# Bound to the reconfigure notify event of a canvas, this
|
|
# method resets canvas's correct width (since we are fill x)
|
|
# and redraws the beveled edge border.
|
|
# will hold the tabs.
|
|
# ----------------------------------------------------------------------
|
|
itcl::body iwidgets::Tabset::_canvasReconfigure {width height} {
|
|
set _canvasWidth $width
|
|
set _canvasHeight $height
|
|
|
|
if { [llength $_tabs] > 0 } {
|
|
_drawBevelBorder
|
|
}
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# PRIVATE METHOD: _startMove
|
|
#
|
|
# This method is bound to the MB2 down in the canvas area of the
|
|
# tab set. This starts animated scrolling of the tabs along their
|
|
# major axis.
|
|
# ----------------------------------------------------------------------
|
|
itcl::body iwidgets::Tabset::_startMove {x y} {
|
|
if { $itk_option(-tabpos) == "n" || $itk_option(-tabpos) == "s" } {
|
|
set _anchorX $x
|
|
} else {
|
|
set _anchorY $y
|
|
}
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# PRIVATE METHOD: _moveTabs
|
|
#
|
|
# This method is bound to the MB2 motion in the canvas area of the
|
|
# tab set. This causes the tabset to move with the mouse.
|
|
# ----------------------------------------------------------------------
|
|
itcl::body iwidgets::Tabset::_moveTabs {x y} {
|
|
if { $itk_option(-tabpos) == "n" || $itk_option(-tabpos) == "s" } {
|
|
set startX [expr {$_start + $x - $_anchorX}]
|
|
foreach tab $_tabs {
|
|
$tab configure -left $startX
|
|
set startX [expr {$startX + [_calcNextTabOffset $tab]}]
|
|
}
|
|
} else {
|
|
set startY [expr {$_start + $y - $_anchorY}]
|
|
foreach tab $_tabs {
|
|
$tab configure -top $startY
|
|
set startY [expr {$startY + [_calcNextTabOffset $tab]}]
|
|
}
|
|
}
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# PRIVATE METHOD: _endMove
|
|
#
|
|
# This method is bound to the MB2 release in the canvas area of the
|
|
# tab set. This causes the tabset to end moving tabs.
|
|
# ----------------------------------------------------------------------
|
|
itcl::body iwidgets::Tabset::_endMove {x y} {
|
|
if { $itk_option(-tabpos) == "n" || $itk_option(-tabpos) == "s" } {
|
|
set startX [expr {$_start + $x - $_anchorX}]
|
|
set _skipRelayout true
|
|
configure -start $startX
|
|
set _skipRelayout false
|
|
} else {
|
|
set startY [expr {$_start + $y - $_anchorY}]
|
|
set _skipRelayout true
|
|
configure -start $startY
|
|
set _skipRelayout false
|
|
}
|
|
}
|
|
|
|
|
|
#==============================================================
|
|
# CLASS: Tab
|
|
#==============================================================
|
|
|
|
itcl::class iwidgets::Tab {
|
|
constructor {args} {}
|
|
|
|
destructor {}
|
|
|
|
public variable bevelamount 0 {}
|
|
public variable state normal {}
|
|
public variable height 0 {}
|
|
public variable width 0 {}
|
|
public variable anchor c {}
|
|
public variable left 0 {}
|
|
public variable top 0 {}
|
|
public variable image {} {}
|
|
public variable bitmap {} {}
|
|
public variable label {} {}
|
|
public variable padx 4 {}
|
|
public variable pady 4 {}
|
|
public variable selectbackground "gray70" {}
|
|
public variable selectforeground "black" {}
|
|
public variable disabledforeground "gray" {}
|
|
public variable background "white" {}
|
|
public variable foreground "black" {}
|
|
public variable orient vertical {}
|
|
public variable invert false {}
|
|
public variable angle 20 {}
|
|
public variable font \
|
|
"-adobe-helvetica-bold-r-normal--34-240-100-100-p-182-iso8859-1" {}
|
|
public variable tabborders true {}
|
|
|
|
public method configure {args}
|
|
public method bbox {}
|
|
public method deselect {}
|
|
public method lower {}
|
|
public method majordim {}
|
|
public method minordim {}
|
|
public method offset {}
|
|
public method raise {}
|
|
public method select {}
|
|
public method labelheight {}
|
|
public method labelwidth {}
|
|
|
|
private method _makeTab {}
|
|
private method _createLabel {canvas tagList}
|
|
private method _makeEastTab {canvas}
|
|
private method _makeWestTab {canvas}
|
|
private method _makeNorthTab {canvas}
|
|
private method _makeSouthTab {canvas}
|
|
private method _calcLabelDim {labelItem}
|
|
private method _itk_config {args} @itcl-builtin-configure
|
|
private method _selectNoRaise {}
|
|
private method _deselectNoLower {}
|
|
|
|
private variable _selected false
|
|
private variable _padX 0
|
|
private variable _padY 0
|
|
|
|
private variable _canvas
|
|
|
|
# these are in pixels
|
|
private variable _left 0
|
|
private variable _width 0
|
|
private variable _height 0
|
|
private variable _oldLeft 0
|
|
private variable _top 0
|
|
private variable _oldTop 0
|
|
|
|
private variable _right
|
|
private variable _bottom
|
|
|
|
private variable _offset
|
|
private variable _majorDim
|
|
private variable _minorDim
|
|
|
|
private variable _darkShadow
|
|
private variable _lightShadow
|
|
|
|
#
|
|
# graphic components that make up a tab
|
|
#
|
|
private variable _gRegion
|
|
private variable _gLabel
|
|
private variable _gLightOutline {}
|
|
private variable _gBlackOutline {}
|
|
private variable _gTopLine
|
|
private variable _gTopLineShadow
|
|
private variable _gLightShadow
|
|
private variable _gDarkShadow
|
|
|
|
private variable _labelWidth 0
|
|
private variable _labelHeight 0
|
|
|
|
private variable _labelXOrigin 0
|
|
private variable _labelYOrigin 0
|
|
|
|
private variable _just left
|
|
|
|
private variable _configTripped true
|
|
|
|
common _tan
|
|
|
|
set _tan(0) 0.0
|
|
set _tan(1) 0.0175
|
|
set _tan(2) 0.0349
|
|
set _tan(3) 0.0524
|
|
set _tan(4) 0.0699
|
|
set _tan(5) 0.0875
|
|
set _tan(6) 0.1051
|
|
set _tan(7) 0.1228
|
|
set _tan(8) 0.1405
|
|
set _tan(9) 0.1584
|
|
set _tan(10) 0.1763
|
|
set _tan(11) 0.1944
|
|
set _tan(12) 0.2126
|
|
set _tan(13) 0.2309
|
|
set _tan(14) 0.2493
|
|
set _tan(15) 0.2679
|
|
set _tan(16) 0.2867
|
|
set _tan(17) 0.3057
|
|
set _tan(18) 0.3249
|
|
set _tan(19) 0.3443
|
|
set _tan(20) 0.3640
|
|
set _tan(21) 0.3839
|
|
set _tan(22) 0.4040
|
|
set _tan(23) 0.4245
|
|
set _tan(24) 0.4452
|
|
set _tan(25) 0.4663
|
|
set _tan(26) 0.4877
|
|
set _tan(27) 0.5095
|
|
set _tan(28) 0.5317
|
|
set _tan(29) 0.5543
|
|
set _tan(30) 0.5774
|
|
set _tan(31) 0.6009
|
|
set _tan(32) 0.6294
|
|
set _tan(33) 0.6494
|
|
set _tan(34) 0.6745
|
|
set _tan(35) 0.7002
|
|
set _tan(36) 0.7265
|
|
set _tan(37) 0.7536
|
|
set _tan(38) 0.7813
|
|
set _tan(39) 0.8098
|
|
set _tan(40) 0.8391
|
|
set _tan(41) 0.8693
|
|
set _tan(42) 0.9004
|
|
set _tan(43) 0.9325
|
|
set _tan(44) 0.9657
|
|
set _tan(45) 1.0
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# CONSTRUCTOR
|
|
# ----------------------------------------------------------------------
|
|
itcl::body iwidgets::Tab::constructor {args} {
|
|
|
|
set _canvas [lindex $args 0]
|
|
set args [lrange $args 1 [llength $args]]
|
|
|
|
set _darkShadow [iwidgets::colors::bottomShadow $selectbackground]
|
|
set _lightShadow [iwidgets::colors::topShadow $selectbackground]
|
|
|
|
if { $args != "" } {
|
|
eval configure $args
|
|
}
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# DESTRUCTOR
|
|
# ----------------------------------------------------------------------
|
|
itcl::body iwidgets::Tab::destructor {} {
|
|
if { [winfo exists $_canvas] } {
|
|
$_canvas delete $this
|
|
}
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# OPTIONS
|
|
# ----------------------------------------------------------------------
|
|
#
|
|
# Note, we trip _configTripped for every option that requires the tab
|
|
# to be remade.
|
|
#
|
|
# ----------------------------------------------------------------------
|
|
# OPTION -bevelamount
|
|
#
|
|
# Specifies the size of tab corners. A value of 0 with angle set
|
|
# to 0 results in square tabs. A bevelAmount of 4, means that the
|
|
# tab will be drawn with angled corners that cut in 4 pixels from
|
|
# the edge of the tab. The default is 0.
|
|
# ----------------------------------------------------------------------
|
|
itcl::configbody iwidgets::Tab::bevelamount {
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# OPTION -state
|
|
#
|
|
# sets the active state of the tab. specifying normal allows
|
|
# the tab to be selectable. Specifying disabled disables the tab,
|
|
# causing its image, bitmap, or label to be drawn with the
|
|
# disabledForeground color.
|
|
# ----------------------------------------------------------------------
|
|
itcl::configbody iwidgets::Tab::state {
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# OPTION -height
|
|
#
|
|
# the height of the tab. if 0, uses the font label height.
|
|
# ----------------------------------------------------------------------
|
|
itcl::configbody iwidgets::Tab::height {
|
|
set _height [winfo pixels $_canvas $height]
|
|
set _configTripped true
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# OPTION -width
|
|
#
|
|
# The width of the tab. If 0, uses the font label width.
|
|
# ----------------------------------------------------------------------
|
|
itcl::configbody iwidgets::Tab::width {
|
|
set _width [winfo pixels $_canvas $width]
|
|
set _configTripped true
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# OPTION -anchor
|
|
#
|
|
# Where the text in the tab will be anchored: n,nw,ne,s,sw,se,e,w,center
|
|
# ----------------------------------------------------------------------
|
|
itcl::configbody iwidgets::Tab::anchor {
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# OPTION -left
|
|
#
|
|
# Specifies the left edge of the tab's bounding box. This value
|
|
# may have any of the forms acceptable to Tk_GetPixels.
|
|
# ----------------------------------------------------------------------
|
|
itcl::configbody iwidgets::Tab::left {
|
|
|
|
# get into pixels
|
|
set _left [winfo pixels $_canvas $left]
|
|
|
|
# move by offset from last setting
|
|
$_canvas move $this [expr {$_left - $_oldLeft}] 0
|
|
|
|
# update old for next time
|
|
set _oldLeft $_left
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# OPTION -top
|
|
#
|
|
# Specifies the topedge of the tab's bounding box. This value may
|
|
# have any of the forms acceptable to Tk_GetPixels.
|
|
# ----------------------------------------------------------------------
|
|
itcl::configbody iwidgets::Tab::top {
|
|
|
|
# get into pixels
|
|
set _top [winfo pixels $_canvas $top]
|
|
|
|
# move by offset from last setting
|
|
$_canvas move $this 0 [expr {$_top - $_oldTop}]
|
|
|
|
# update old for next time
|
|
set _oldTop $_top
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# OPTION -image
|
|
#
|
|
# Specifies the imageto display in the tab.
|
|
# Images are created with the image create command.
|
|
# ----------------------------------------------------------------------
|
|
itcl::configbody iwidgets::Tab::image {
|
|
set _configTripped true
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# OPTION -bitmap
|
|
#
|
|
# If bitmap is an empty string, specifies the bitmap to display in
|
|
# the tab. Bitmap may be of any of the forms accepted by Tk_GetBitmap.
|
|
# ----------------------------------------------------------------------
|
|
itcl::configbody iwidgets::Tab::bitmap {
|
|
set _configTripped true
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# OPTION -label
|
|
#
|
|
# If image is an empty string and bitmap is an empty string,
|
|
# it specifies a text string to be placed in the tab's label.
|
|
# This label serves as an additional identifier used to reference
|
|
# the tab. Label may be used for the index value in widget commands.
|
|
# ----------------------------------------------------------------------
|
|
itcl::configbody iwidgets::Tab::label {
|
|
set _configTripped true
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# OPTION -padx
|
|
#
|
|
# Horizontal padding around the label (text, image, or bitmap).
|
|
# ----------------------------------------------------------------------
|
|
itcl::configbody iwidgets::Tab::padx {
|
|
set _configTripped true
|
|
set _padX [winfo pixels $_canvas $padx]
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# OPTION -pady
|
|
#
|
|
# Vertical padding around the label (text, image, or bitmap).
|
|
# ----------------------------------------------------------------------
|
|
itcl::configbody iwidgets::Tab::pady {
|
|
set _configTripped true
|
|
set _padY [winfo pixels $_canvas $pady]
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# OPTION -selectbackground
|
|
# ----------------------------------------------------------------------
|
|
itcl::configbody iwidgets::Tab::selectbackground {
|
|
set _darkShadow [iwidgets::colors::bottomShadow $selectbackground]
|
|
set _lightShadow [iwidgets::colors::topShadow $selectbackground]
|
|
|
|
if { $_selected } {
|
|
_selectNoRaise
|
|
} else {
|
|
_deselectNoLower
|
|
}
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# OPTION -selectforeground
|
|
#
|
|
# Foreground of tab when selected
|
|
# ----------------------------------------------------------------------
|
|
itcl::configbody iwidgets::Tab::selectforeground {
|
|
if { $_selected } {
|
|
_selectNoRaise
|
|
} else {
|
|
_deselectNoLower
|
|
}
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# OPTION -disabledforeground
|
|
#
|
|
# Background of tab when -state is disabled
|
|
# ----------------------------------------------------------------------
|
|
itcl::configbody iwidgets::Tab::disabledforeground {
|
|
if { $_selected } {
|
|
_selectNoRaise
|
|
} else {
|
|
_deselectNoLower
|
|
}
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# OPTION -background
|
|
#
|
|
# Normal background of tab.
|
|
# ----------------------------------------------------------------------
|
|
itcl::configbody iwidgets::Tab::background {
|
|
|
|
if { $_selected } {
|
|
_selectNoRaise
|
|
} else {
|
|
_deselectNoLower
|
|
}
|
|
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# OPTION -foreground
|
|
#
|
|
# Foreground of tabs when in normal unselected state
|
|
# ----------------------------------------------------------------------
|
|
itcl::configbody iwidgets::Tab::foreground {
|
|
if { $_selected } {
|
|
_selectNoRaise
|
|
} else {
|
|
_deselectNoLower
|
|
}
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# OPTION -orient
|
|
#
|
|
# Specifies the orientation of the tab. Orient can be either
|
|
# horizontal or vertical.
|
|
# ----------------------------------------------------------------------
|
|
itcl::configbody iwidgets::Tab::orient {
|
|
set _configTripped true
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# OPTION -invert
|
|
#
|
|
# Specifies the direction to draw the tab. If invert is true,
|
|
# it draws horizontal tabs upside down and vertical tabs opening
|
|
# to the left (pointing right). The value may have any of the
|
|
# forms accepted by the Tcl_GetBoolean, such as true,
|
|
# false, 0, 1, yes, or no.
|
|
# ----------------------------------------------------------------------
|
|
itcl::configbody iwidgets::Tab::invert {
|
|
set _configTripped true
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# OPTION -angle
|
|
#
|
|
# Specifes the angle of slope from the inner edge to the outer edge
|
|
# of the tab. An angle of 0 specifies square tabs. Valid ranges are
|
|
# 0 to 45 degrees inclusive. Default is 15 degrees. If this option
|
|
# is specified as an empty string (the default), then the angle
|
|
# option for the overall Tabset is used.
|
|
# ----------------------------------------------------------------------
|
|
itcl::configbody iwidgets::Tab::angle {
|
|
if {$angle < 0 || $angle > 45 } {
|
|
error "bad angle: must be between 0 and 45"
|
|
}
|
|
set _configTripped true
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# OPTION -font
|
|
#
|
|
# Font for tab text.
|
|
# ----------------------------------------------------------------------
|
|
itcl::configbody iwidgets::Tab::font {
|
|
}
|
|
|
|
|
|
# ----------------------------------------------------------------------
|
|
# OPTION -tabborders
|
|
#
|
|
# Specifies whether to draw the borders of a deselected tab.
|
|
# Specifying true (the default) draws these borders,
|
|
# specifying false disables this drawing. If the tab is in
|
|
# its selected state this option has no effect.
|
|
# The value may have any of the forms accepted by the
|
|
# Tcl_GetBoolean, such as true, false, 0, 1, yes, or no.
|
|
# ----------------------------------------------------------------------
|
|
itcl::configbody iwidgets::Tab::tabborders {
|
|
set _configTripped true
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# METHOD: configure ?option value?
|
|
#
|
|
# Configures the Tab, checks a configTripped flag to see if the tab
|
|
# needs to be remade. We take the easy way since it is so inexpensive
|
|
# to delete canvas items and remake them.
|
|
# ----------------------------------------------------------------------
|
|
itcl::body iwidgets::Tab::configure {args} {
|
|
set len [llength $args]
|
|
|
|
switch $len {
|
|
0 {
|
|
set result [_itk_config]
|
|
return $result
|
|
}
|
|
1 {
|
|
set result [eval _itk_config $args]
|
|
return $result
|
|
}
|
|
default {
|
|
eval _itk_config $args
|
|
if { $_configTripped } {
|
|
_makeTab
|
|
set _configTripped false
|
|
}
|
|
return ""
|
|
}
|
|
}
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# METHOD: bbox
|
|
#
|
|
# Returns the bounding box of the tab
|
|
# ----------------------------------------------------------------------
|
|
itcl::body iwidgets::Tab::bbox {} {
|
|
return [lappend bbox $_left $_top $_right $_bottom]
|
|
}
|
|
# ----------------------------------------------------------------------
|
|
# METHOD: deselect
|
|
#
|
|
# Causes the given tab to be drawn as deselected and lowered
|
|
# ----------------------------------------------------------------------
|
|
itcl::body iwidgets::Tab::deselect {} {
|
|
global tcl_platform
|
|
$_canvas lower $this
|
|
|
|
if {$tcl_platform(os) == "HP-UX"} {
|
|
update idletasks
|
|
}
|
|
|
|
_deselectNoLower
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# METHOD: lower
|
|
#
|
|
# Lowers the tab below all others in the canvas.
|
|
#
|
|
# This is used as our tag name on the canvas.
|
|
# ----------------------------------------------------------------------
|
|
itcl::body iwidgets::Tab::lower {} {
|
|
$_canvas lower $this
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# METHOD: majordim
|
|
#
|
|
# Returns the width for horizontal tabs and the height for
|
|
# vertical tabs.
|
|
# ----------------------------------------------------------------------
|
|
itcl::body iwidgets::Tab::majordim {} {
|
|
return $_majorDim
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# METHOD: minordim
|
|
#
|
|
# Returns the height for horizontal tabs and the width for
|
|
# vertical tabs.
|
|
# ----------------------------------------------------------------------
|
|
itcl::body iwidgets::Tab::minordim {} {
|
|
return $_minorDim
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# METHOD: offset
|
|
#
|
|
# Returns the width less the angle offset. This allows a
|
|
# geometry manager to ask where to place a sibling tab.
|
|
# ----------------------------------------------------------------------
|
|
itcl::body iwidgets::Tab::offset {} {
|
|
return $_offset
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# METHOD: raise
|
|
#
|
|
# Raises the tab above all others in the canvas.
|
|
#
|
|
# This is used as our tag name on the canvas.
|
|
# ----------------------------------------------------------------------
|
|
itcl::body iwidgets::Tab::raise {} {
|
|
$_canvas raise $this
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# METHOD: select
|
|
#
|
|
# Causes the given tab to be drawn as selected. 3d shadows are
|
|
# turned on and top line and top line shadow are drawn in sel
|
|
# bg color to hide them.
|
|
# ----------------------------------------------------------------------
|
|
itcl::body iwidgets::Tab::select {} {
|
|
global tcl_platform
|
|
$_canvas raise $this
|
|
|
|
if {$tcl_platform(os) == "HP-UX"} {
|
|
update idletasks
|
|
}
|
|
|
|
_selectNoRaise
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# METHOD: labelheight
|
|
#
|
|
# Returns the height of the tab's label in its current font.
|
|
# ----------------------------------------------------------------------
|
|
itcl::body iwidgets::Tab::labelheight {} {
|
|
if {$_gLabel != 0} {
|
|
set labelBBox [$_canvas bbox $_gLabel]
|
|
set labelHeight [expr {[lindex $labelBBox 3] - [lindex $labelBBox 1]}]
|
|
} else {
|
|
set labelHeight 0
|
|
}
|
|
return $labelHeight
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# METHOD: labelwidth
|
|
#
|
|
# Returns the width of the tab's label in its current font.
|
|
# ----------------------------------------------------------------------
|
|
itcl::body iwidgets::Tab::labelwidth {} {
|
|
if {$_gLabel != 0} {
|
|
set labelBBox [$_canvas bbox $_gLabel]
|
|
set labelWidth [expr {[lindex $labelBBox 2] - [lindex $labelBBox 0]}]
|
|
} else {
|
|
set labelWidth 0
|
|
}
|
|
return $labelWidth
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# PRIVATE METHOD: _selectNoRaise
|
|
#
|
|
# Draws tab as selected without raising it.
|
|
# ----------------------------------------------------------------------
|
|
itcl::body iwidgets::Tab::_selectNoRaise {} {
|
|
if { ! [info exists _gRegion] } {
|
|
return
|
|
}
|
|
|
|
$_canvas itemconfigure $_gRegion -fill $selectbackground
|
|
$_canvas itemconfigure $_gTopLine -fill $selectbackground
|
|
$_canvas itemconfigure $_gTopLineShadow -fill $selectbackground
|
|
$_canvas itemconfigure $_gLightShadow -fill $_lightShadow
|
|
$_canvas itemconfigure $_gDarkShadow -fill $_darkShadow
|
|
|
|
if { $_gLightOutline != {} } {
|
|
$_canvas itemconfigure $_gLightOutline -fill $_lightShadow
|
|
}
|
|
if { $_gBlackOutline != {} } {
|
|
$_canvas itemconfigure $_gBlackOutline -fill black
|
|
}
|
|
|
|
if { $state == "normal" } {
|
|
if { $image != {}} {
|
|
# do nothing for now
|
|
} elseif { $bitmap != {}} {
|
|
$_canvas itemconfigure $_gLabel \
|
|
-foreground $selectforeground \
|
|
-background $selectbackground
|
|
} else {
|
|
$_canvas itemconfigure $_gLabel -fill $selectforeground
|
|
}
|
|
} else {
|
|
if { $image != {}} {
|
|
# do nothing for now
|
|
} elseif { $bitmap != {}} {
|
|
$_canvas itemconfigure $_gLabel \
|
|
-foreground $disabledforeground \
|
|
-background $selectbackground
|
|
} else {
|
|
$_canvas itemconfigure $_gLabel -fill $disabledforeground
|
|
}
|
|
}
|
|
|
|
set _selected true
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# PRIVATE METHOD: _deselectNoLower
|
|
#
|
|
# Causes the given tab to be drawn as deselected. 3d shadows are
|
|
# removed and top line and top line shadow are drawn in visible
|
|
# colors to reveal them.
|
|
# ----------------------------------------------------------------------
|
|
itcl::body iwidgets::Tab::_deselectNoLower {} {
|
|
if { ! [info exists _gRegion] } {
|
|
return
|
|
}
|
|
|
|
$_canvas itemconfigure $_gRegion -fill $background
|
|
$_canvas itemconfigure $_gTopLine -fill black
|
|
$_canvas itemconfigure $_gTopLineShadow -fill $_darkShadow
|
|
$_canvas itemconfigure $_gLightShadow -fill $background
|
|
$_canvas itemconfigure $_gDarkShadow -fill $background
|
|
|
|
if { $tabborders } {
|
|
if { $_gLightOutline != {} } {
|
|
$_canvas itemconfigure $_gLightOutline -fill $_lightShadow
|
|
}
|
|
if { $_gBlackOutline != {} } {
|
|
$_canvas itemconfigure $_gBlackOutline -fill black
|
|
}
|
|
} else {
|
|
if { $_gLightOutline != {} } {
|
|
$_canvas itemconfigure $_gLightOutline -fill $background
|
|
}
|
|
if { $_gBlackOutline != {} } {
|
|
$_canvas itemconfigure $_gBlackOutline -fill $background
|
|
}
|
|
}
|
|
|
|
|
|
if { $state == "normal" } {
|
|
if { $image != {}} {
|
|
# do nothing for now
|
|
} elseif { $bitmap != {}} {
|
|
$_canvas itemconfigure $_gLabel \
|
|
-foreground $foreground \
|
|
-background $background
|
|
} else {
|
|
$_canvas itemconfigure $_gLabel -fill $foreground
|
|
}
|
|
} else {
|
|
if { $image != {}} {
|
|
# do nothing for now
|
|
} elseif { $bitmap != {}} {
|
|
$_canvas itemconfigure $_gLabel \
|
|
-foreground $disabledforeground \
|
|
-background $background
|
|
} else {
|
|
$_canvas itemconfigure $_gLabel -fill $disabledforeground
|
|
}
|
|
}
|
|
|
|
set _selected false
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# PRIVATE METHOD: _makeTab
|
|
# ----------------------------------------------------------------------
|
|
itcl::body iwidgets::Tab::_makeTab {} {
|
|
if { $orient == "horizontal" } {
|
|
if { $invert } {
|
|
_makeNorthTab $_canvas
|
|
} else {
|
|
_makeSouthTab $_canvas
|
|
}
|
|
} elseif { $orient == "vertical" } {
|
|
if { $invert } {
|
|
_makeEastTab $_canvas
|
|
} else {
|
|
_makeWestTab $_canvas
|
|
}
|
|
} else {
|
|
error "bad value for option -orient"
|
|
}
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# PRIVATE METHOD: _createLabel
|
|
#
|
|
# Creates the label for the tab. Can be either a text label
|
|
# or a bitmap label.
|
|
# ----------------------------------------------------------------------
|
|
itcl::body iwidgets::Tab::_createLabel {canvas tagList} {
|
|
if { $image != {}} {
|
|
set _gLabel [$canvas create image \
|
|
0 0 \
|
|
-image $image \
|
|
-anchor nw \
|
|
-tags $tagList \
|
|
]
|
|
} elseif { $bitmap != {}} {
|
|
set _gLabel [$canvas create bitmap \
|
|
0 0 \
|
|
-bitmap $bitmap \
|
|
-anchor nw \
|
|
-tags $tagList \
|
|
]
|
|
} else {
|
|
set _gLabel [$canvas create text \
|
|
0 0 \
|
|
-text $label \
|
|
-font $font \
|
|
-anchor nw \
|
|
-tags $tagList \
|
|
]
|
|
}
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# PRIVATE METHOD: _makeEastTab
|
|
#
|
|
# Makes a tab that hangs to the east and opens to the west.
|
|
# ----------------------------------------------------------------------
|
|
itcl::body iwidgets::Tab::_makeEastTab {canvas} {
|
|
$canvas delete $this
|
|
set _gLightOutline {}
|
|
set _gBlackOutline {}
|
|
|
|
lappend tagList $this TAB
|
|
|
|
_createLabel $canvas $tagList
|
|
|
|
_calcLabelDim $_gLabel
|
|
|
|
|
|
set right [expr {$_left + $_labelWidth}]
|
|
# now have _left, _top, right...
|
|
|
|
# Turn off calculating angle tabs on Vertical orientations
|
|
set angleOffset 0
|
|
|
|
set outerTop $_top
|
|
set outerBottom \
|
|
[expr {$outerTop + $angleOffset + $_labelHeight + $angleOffset}]
|
|
set innerTop [expr {$outerTop + $angleOffset}]
|
|
set innerBottom [expr {$outerTop + $angleOffset + $_labelHeight}]
|
|
|
|
# now have _left, _top, right, outerTop, innerTop,
|
|
# innerBottom, outerBottom, width, height
|
|
|
|
set bottom $innerBottom
|
|
# tab area... gets filled either white or selected
|
|
# done
|
|
set _gRegion [$canvas create polygon \
|
|
$_left $outerTop \
|
|
[expr {$right - $bevelamount}] $innerTop \
|
|
$right [expr {$innerTop + $bevelamount}] \
|
|
$right [expr {$innerBottom - $bevelamount}] \
|
|
[expr {$right - $bevelamount}] $innerBottom \
|
|
$_left $outerBottom \
|
|
$_left $outerTop \
|
|
-tags $tagList \
|
|
]
|
|
|
|
# lighter shadow (left edge)
|
|
set _gLightShadow [$canvas create line \
|
|
[expr {$_left - 3}] [expr {$outerTop + 1}] \
|
|
[expr {$right - $bevelamount}] [expr {$innerTop + 1}] \
|
|
-tags $tagList \
|
|
]
|
|
|
|
# darker shadow (bottom and right edges)
|
|
set _gDarkShadow [$canvas create line \
|
|
[expr {$right - $bevelamount}] [expr {$innerTop + 1}] \
|
|
[expr {$right - 1}] [expr {$innerTop + $bevelamount}] \
|
|
[expr {$right - 1}] [expr {$innerBottom - $bevelamount}] \
|
|
[expr {$right - $bevelamount}] [expr {$innerBottom - 1}] \
|
|
[expr {$_left - 3}] [expr {$outerBottom - 1}] \
|
|
-tags $tagList \
|
|
]
|
|
|
|
# outline of tab
|
|
set _gLightOutline [$canvas create line \
|
|
$_left $outerTop \
|
|
[expr {$right - $bevelamount}] $innerTop \
|
|
-tags $tagList \
|
|
]
|
|
# outline of tab
|
|
set _gBlackOutline [$canvas create line \
|
|
[expr {$right - $bevelamount}] $innerTop \
|
|
$right [expr {$innerTop + $bevelamount}] \
|
|
$right [expr {$innerBottom - $bevelamount}] \
|
|
[expr {$right - $bevelamount}] $innerBottom \
|
|
$_left $outerBottom \
|
|
$_left $outerTop \
|
|
-tags $tagList \
|
|
]
|
|
|
|
# line closest to the edge
|
|
set _gTopLineShadow [$canvas create line \
|
|
$_left $outerTop \
|
|
$_left $outerBottom \
|
|
-tags $tagList \
|
|
]
|
|
|
|
# next line down
|
|
set _gTopLine [$canvas create line \
|
|
[expr {$_left + 1}] [expr {$outerTop + 2}] \
|
|
[expr {$_left + 1}] [expr {$outerBottom - 1}] \
|
|
-tags $tagList \
|
|
]
|
|
|
|
$canvas coords $_gLabel [expr {$_left + $_labelXOrigin}] \
|
|
[expr {$innerTop + $_labelYOrigin}]
|
|
|
|
if { $image != {} || $bitmap != {} } {
|
|
$canvas itemconfigure $_gLabel -anchor $anchor
|
|
} else {
|
|
$canvas itemconfigure $_gLabel -anchor $anchor -justify $_just
|
|
}
|
|
|
|
$canvas raise $_gLabel $_gRegion
|
|
|
|
|
|
set _offset [expr {$innerBottom - $outerTop}]
|
|
# height
|
|
set _majorDim [expr {$outerBottom - $outerTop}]
|
|
# width
|
|
set _minorDim [expr {$right - $_left}]
|
|
|
|
set _right $right
|
|
set _bottom $outerBottom
|
|
|
|
# draw in correct state...
|
|
if { $_selected } {
|
|
select
|
|
} else {
|
|
deselect
|
|
}
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# PRIVATE METHOD: _makeWestTab
|
|
#
|
|
# Makes a tab that hangs to the west and opens to the east.
|
|
# ----------------------------------------------------------------------
|
|
itcl::body iwidgets::Tab::_makeWestTab {canvas} {
|
|
$canvas delete $this
|
|
set _gLightOutline {}
|
|
set _gBlackOutline {}
|
|
|
|
lappend tagList $this TAB
|
|
|
|
_createLabel $canvas $tagList
|
|
_calcLabelDim $_gLabel
|
|
|
|
set right [expr {$_left + $_labelWidth}]
|
|
# now have _left, _top, right...
|
|
|
|
# Turn off calculating angle tabs on Vertical orientations
|
|
set angleOffset 0
|
|
|
|
set outerTop $_top
|
|
set outerBottom \
|
|
[expr {$outerTop + $angleOffset + $_labelHeight + $angleOffset}]
|
|
set innerTop [expr {$outerTop + $angleOffset}]
|
|
set innerBottom [expr {$outerTop + $angleOffset + $_labelHeight}]
|
|
|
|
# now have _left, _top, right, outerTop, innerTop,
|
|
# innerBottom, outerBottom, width, height
|
|
|
|
# tab area... gets filled either white or selected
|
|
# done
|
|
set _gRegion [$canvas create polygon \
|
|
$right $outerTop \
|
|
[expr {$_left + $bevelamount}] $innerTop \
|
|
$_left [expr {$innerTop + $bevelamount}] \
|
|
$_left [expr {$innerBottom - $bevelamount}]\
|
|
[expr {$_left + $bevelamount}] $innerBottom \
|
|
$right $outerBottom \
|
|
$right $outerTop \
|
|
-tags $tagList \
|
|
]
|
|
# lighter shadow (left edge)
|
|
set _gLightShadow [$canvas create line \
|
|
$right [expr {$outerTop+1}] \
|
|
[expr {$_left + $bevelamount}] [expr {$innerTop + 1}] \
|
|
[expr {$_left + 1}] [expr {$innerTop + $bevelamount}] \
|
|
[expr {$_left + 1}] [expr {$innerBottom - $bevelamount}] \
|
|
-tags $tagList \
|
|
]
|
|
|
|
# darker shadow (bottom and right edges)
|
|
set _gDarkShadow [$canvas create line \
|
|
[expr {$_left + 1}] [expr {$innerBottom - $bevelamount}] \
|
|
[expr {$_left + $bevelamount}] [expr {$innerBottom - 1}] \
|
|
$right [expr {$outerBottom - 1}] \
|
|
-tags $tagList \
|
|
]
|
|
|
|
# outline of tab -- lighter top left sides
|
|
set _gLightOutline [$canvas create line \
|
|
$right $outerTop \
|
|
[expr {$_left + $bevelamount}] $innerTop \
|
|
$_left [expr {$innerTop + $bevelamount}] \
|
|
$_left [expr {$innerBottom - $bevelamount}]\
|
|
-tags $tagList \
|
|
]
|
|
# outline of tab -- darker bottom side
|
|
set _gBlackOutline [$canvas create line \
|
|
$_left [expr {$innerBottom - $bevelamount}]\
|
|
[expr {$_left + $bevelamount}] $innerBottom \
|
|
$right $outerBottom \
|
|
$right $outerTop \
|
|
-tags $tagList \
|
|
]
|
|
|
|
# top of tab
|
|
set _gTopLine [$canvas create line \
|
|
[expr {$right + 1}] $outerTop \
|
|
[expr {$right + 1}] $outerBottom \
|
|
-tags $tagList \
|
|
]
|
|
|
|
# line below top of tab
|
|
set _gTopLineShadow [$canvas create line \
|
|
$right $outerTop \
|
|
$right $outerBottom \
|
|
-tags $tagList \
|
|
]
|
|
|
|
$canvas coords $_gLabel [expr {$_left + $_labelXOrigin}] \
|
|
[expr {$innerTop + $_labelYOrigin}]
|
|
if { $image != {} || $bitmap != {} } {
|
|
$canvas itemconfigure $_gLabel -anchor $anchor
|
|
} else {
|
|
$canvas itemconfigure $_gLabel -anchor $anchor -justify $_just
|
|
}
|
|
|
|
$canvas raise $_gLabel $_gRegion
|
|
|
|
|
|
set _offset [expr {$innerBottom - $outerTop}]
|
|
# height
|
|
set _majorDim [expr {$outerBottom - $outerTop}]
|
|
# width
|
|
set _minorDim [expr {$right - $_left}]
|
|
|
|
set _right $right
|
|
set _bottom $outerBottom
|
|
|
|
# draw in correct state...
|
|
if { $_selected } {
|
|
select
|
|
} else {
|
|
deselect
|
|
}
|
|
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# PRIVATE METHOD: _makeNorthTab
|
|
#
|
|
# Makes a tab that hangs to the north and opens to the south.
|
|
# ----------------------------------------------------------------------
|
|
itcl::body iwidgets::Tab::_makeNorthTab {canvas} {
|
|
$canvas delete $this
|
|
set _gLightOutline {}
|
|
set _gBlackOutline {}
|
|
|
|
lappend tagList $this TAB
|
|
|
|
_createLabel $canvas $tagList
|
|
|
|
# first get the label width and height
|
|
_calcLabelDim $_gLabel
|
|
|
|
set bottom [expr {$_top + $_labelHeight}]
|
|
|
|
set angleOffset [expr {$_labelHeight * $_tan($angle)}]
|
|
|
|
set outerLeft $_left
|
|
set outerRight \
|
|
[expr {$outerLeft + $angleOffset + $_labelWidth + $angleOffset}]
|
|
set innerLeft [expr {$outerLeft + $angleOffset}]
|
|
set innerRight [expr {$outerLeft + $angleOffset + $_labelWidth}]
|
|
|
|
# tab area... gets filled either white or selected
|
|
set _gRegion [$canvas create polygon \
|
|
$outerLeft [expr {$bottom + 3}] \
|
|
$innerLeft [expr {$_top + $bevelamount}] \
|
|
[expr {$innerLeft + $bevelamount}] $_top \
|
|
[expr {$innerRight - $bevelamount}] $_top \
|
|
$innerRight [expr {$_top + $bevelamount}]\
|
|
$outerRight [expr {$bottom + 3}] \
|
|
$outerLeft [expr {$bottom + 3}] \
|
|
-tags $tagList \
|
|
]
|
|
|
|
# lighter shadow (left edge)
|
|
set _gLightShadow [$canvas create line \
|
|
[expr {$outerLeft + 1}] [expr {$bottom + 3}] \
|
|
[expr {$innerLeft + 1}] [expr {$_top + $bevelamount}] \
|
|
[expr {$innerLeft + $bevelamount}] [expr {$_top + 1}]\
|
|
[expr {$innerRight - $bevelamount}] [expr {$_top + 1}]\
|
|
-tags $tagList \
|
|
]
|
|
|
|
# darker shadow (bottom and right edges)
|
|
set _gDarkShadow [$canvas create line \
|
|
[expr {$innerRight - $bevelamount}] [expr {$_top + 1}]\
|
|
[expr {$innerRight - 1}] [expr {$_top + $bevelamount}]\
|
|
[expr {$outerRight - 1}] [expr {$bottom + 3}]\
|
|
-tags $tagList \
|
|
]
|
|
|
|
set _gLightOutline [$canvas create line \
|
|
$outerLeft [expr {$bottom + 3}] \
|
|
$innerLeft [expr {$_top + $bevelamount}] \
|
|
[expr {$innerLeft + $bevelamount}] $_top \
|
|
[expr {$innerRight - $bevelamount}] $_top \
|
|
-tags $tagList \
|
|
]
|
|
|
|
set _gBlackOutline [$canvas create line \
|
|
[expr {$innerRight - $bevelamount}] $_top \
|
|
$innerRight [expr {$_top + $bevelamount}]\
|
|
$outerRight [expr {$bottom + 3}] \
|
|
$outerLeft [expr {$bottom + 3}] \
|
|
-tags $tagList \
|
|
]
|
|
|
|
# top of tab... to make it closed off
|
|
set _gTopLine [$canvas create line \
|
|
0 0 0 0\
|
|
-tags $tagList \
|
|
]
|
|
|
|
# top of tab... to make it closed off
|
|
set _gTopLineShadow [$canvas create line \
|
|
0 0 0 0 \
|
|
-tags $tagList \
|
|
]
|
|
|
|
$canvas coords $_gLabel [expr {$innerLeft + $_labelXOrigin}] \
|
|
[expr {$_top + $_labelYOrigin}]
|
|
|
|
if { $image != {} || $bitmap != {} } {
|
|
$canvas itemconfigure $_gLabel -anchor $anchor
|
|
} else {
|
|
$canvas itemconfigure $_gLabel -anchor $anchor -justify $_just
|
|
}
|
|
|
|
$canvas raise $_gLabel $_gRegion
|
|
|
|
|
|
set _offset [expr {$innerRight - $outerLeft}]
|
|
# width
|
|
set _majorDim [expr {$outerRight - $outerLeft}]
|
|
# height
|
|
set _minorDim [expr {$bottom - $_top}]
|
|
|
|
set _right $outerRight
|
|
set _bottom $bottom
|
|
|
|
# draw in correct state...
|
|
if { $_selected } {
|
|
select
|
|
} else {
|
|
deselect
|
|
}
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# PRIVATE METHOD: _makeSouthTab
|
|
#
|
|
# Makes a tab that hangs to the south and opens to the north.
|
|
# ----------------------------------------------------------------------
|
|
itcl::body iwidgets::Tab::_makeSouthTab {canvas} {
|
|
$canvas delete $this
|
|
set _gLightOutline {}
|
|
set _gBlackOutline {}
|
|
|
|
lappend tagList $this TAB
|
|
|
|
_createLabel $canvas $tagList
|
|
|
|
# first get the label width and height
|
|
_calcLabelDim $_gLabel
|
|
|
|
set bottom [expr {$_top + $_labelHeight}]
|
|
|
|
set angleOffset [expr {$_labelHeight * $_tan($angle)}]
|
|
|
|
set outerLeft $_left
|
|
set outerRight \
|
|
[expr {$outerLeft + $angleOffset + $_labelWidth + $angleOffset}]
|
|
set innerLeft [expr {$outerLeft + $angleOffset}]
|
|
set innerRight [expr {$outerLeft + $angleOffset + $_labelWidth}]
|
|
|
|
# tab area... gets filled either white or selected
|
|
set _gRegion [$canvas create polygon \
|
|
$outerLeft [expr {$_top + 1}] \
|
|
$innerLeft [expr {$bottom - $bevelamount}]\
|
|
[expr {$innerLeft + $bevelamount}] $bottom \
|
|
[expr {$innerRight - $bevelamount}] $bottom \
|
|
$innerRight [expr {$bottom - $bevelamount}]\
|
|
$outerRight [expr {$_top + 1}] \
|
|
$outerLeft [expr {$_top + 1}] \
|
|
-tags $tagList \
|
|
]
|
|
|
|
|
|
# lighter shadow (left edge)
|
|
set _gLightShadow [$canvas create line \
|
|
[expr {$outerLeft+1}] $_top \
|
|
[expr {$innerLeft+1}] [expr {$bottom-$bevelamount}] \
|
|
-tags $tagList \
|
|
]
|
|
|
|
# darker shadow (bottom and right edges)
|
|
set _gDarkShadow [$canvas create line \
|
|
[expr {$innerLeft+1}] [expr {$bottom-$bevelamount}] \
|
|
[expr {$innerLeft+$bevelamount}] [expr {$bottom-1}] \
|
|
[expr {$innerRight-$bevelamount}] [expr {$bottom-1}] \
|
|
[expr {$innerRight-1}] [expr {$bottom-$bevelamount}] \
|
|
[expr {$outerRight-1}] [expr {$_top + 1}] \
|
|
-tags $tagList \
|
|
]
|
|
# outline of tab
|
|
set _gBlackOutline [$canvas create line \
|
|
$outerLeft [expr {$_top + 1}] \
|
|
$innerLeft [expr {$bottom -$bevelamount}]\
|
|
[expr {$innerLeft + $bevelamount}] $bottom \
|
|
[expr {$innerRight - $bevelamount}] $bottom \
|
|
$innerRight [expr {$bottom - $bevelamount}]\
|
|
$outerRight [expr {$_top + 1}] \
|
|
-tags $tagList \
|
|
]
|
|
|
|
# top of tab... to make it closed off
|
|
set _gTopLine [$canvas create line \
|
|
$outerLeft [expr {$_top + 1}] \
|
|
$outerRight [expr {$_top + 1}] \
|
|
-tags $tagList \
|
|
]
|
|
|
|
# top of tab... to make it closed off
|
|
set _gTopLineShadow [$canvas create line \
|
|
$outerLeft $_top \
|
|
$outerRight $_top \
|
|
-tags $tagList \
|
|
]
|
|
|
|
$canvas coords $_gLabel [expr {$innerLeft + $_labelXOrigin}] \
|
|
[expr {$_top + $_labelYOrigin}]
|
|
|
|
if { $image != {} || $bitmap != {} } {
|
|
$canvas itemconfigure $_gLabel -anchor $anchor
|
|
} else {
|
|
$canvas itemconfigure $_gLabel -anchor $anchor -justify $_just
|
|
}
|
|
$canvas raise $_gLabel $_gRegion
|
|
|
|
|
|
set _offset [expr {$innerRight - $outerLeft}]
|
|
|
|
# width
|
|
set _majorDim [expr {$outerRight - $outerLeft}]
|
|
|
|
# height
|
|
set _minorDim [expr {$bottom - $_top}]
|
|
|
|
set _right $outerRight
|
|
set _bottom $bottom
|
|
|
|
# draw in correct state...
|
|
if { $_selected } {
|
|
select
|
|
} else {
|
|
deselect
|
|
}
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# PRIVATE METHOD: _calcLabelDim
|
|
#
|
|
# Calculate the width and height of the label bbox of labelItem
|
|
# can be either text or bitmap (in future also an image)
|
|
#
|
|
# There are two ways to calculate the label bbox.
|
|
#
|
|
# First, if the $_width and/or $_height is specified, we will use
|
|
# it to determine that dimension(s) width and/or height. For
|
|
# a width/height of 0 we use the labels bbox to
|
|
# give us a base width/height.
|
|
# Then we add in the padx/pady to determine final bounds.
|
|
#
|
|
# Uses the following option or option derived variables:
|
|
# -padx ($_padX - converted to pixels)
|
|
# -pady ($_padY - converted to pixels)
|
|
# -anchor ($anchor)
|
|
# -width ($_width) This is the width for inside tab (label area)
|
|
# -height ($_height) This is the width for inside tab (label area)
|
|
#
|
|
# Side Effects:
|
|
# _labelWidth will be set
|
|
# _labelHeight will be set
|
|
# _labelXOrigin will be set
|
|
# _labelYOrigin will be set
|
|
# ----------------------------------------------------------------------
|
|
itcl::body iwidgets::Tab::_calcLabelDim {labelItem} {
|
|
# ... calculate the label width and height
|
|
set labelBBox [$_canvas bbox $labelItem]
|
|
|
|
if { $_width > 0 } {
|
|
set _labelWidth [expr {$_width + ($_padX * 2)}]
|
|
} else {
|
|
set _labelWidth [expr {
|
|
([lindex $labelBBox 2] - [lindex $labelBBox 0]) + ($_padX * 2)}]
|
|
}
|
|
|
|
if { $_height > 0 } {
|
|
set _labelHeight [expr {$_height + ($_padY * 2)}]
|
|
} else {
|
|
set _labelHeight [expr {
|
|
([lindex $labelBBox 3] - [lindex $labelBBox 1]) + ($_padY * 2)}]
|
|
}
|
|
|
|
# ... calculate the label anchor point
|
|
set centerX [expr {$_labelWidth/2.0}]
|
|
set centerY [expr {$_labelHeight/2.0 - 1}]
|
|
|
|
switch $anchor {
|
|
n {
|
|
set _labelXOrigin $centerX
|
|
set _labelYOrigin $_padY
|
|
set _just center
|
|
}
|
|
s {
|
|
set _labelXOrigin $centerX
|
|
set _labelYOrigin [expr {$_labelHeight - $_padY}]
|
|
set _just center
|
|
}
|
|
e {
|
|
set _labelXOrigin [expr {$_labelWidth - $_padX - 1}]
|
|
set _labelYOrigin $centerY
|
|
set _just right
|
|
}
|
|
w {
|
|
set _labelXOrigin [expr {$_padX + 2}]
|
|
set _labelYOrigin $centerY
|
|
set _just left
|
|
}
|
|
c {
|
|
set _labelXOrigin $centerX
|
|
set _labelYOrigin $centerY
|
|
set _just center
|
|
}
|
|
ne {
|
|
set _labelXOrigin [expr {$_labelWidth - $_padX - 1}]
|
|
set _labelYOrigin $_padY
|
|
set _just right
|
|
}
|
|
nw {
|
|
set _labelXOrigin [expr {$_padX + 2}]
|
|
set _labelYOrigin $_padY
|
|
set _just left
|
|
}
|
|
se {
|
|
set _labelXOrigin [expr {$_labelWidth - $_padX - 1}]
|
|
set _labelYOrigin [expr {$_labelHeight - $_padY}]
|
|
set _just right
|
|
}
|
|
sw {
|
|
set _labelXOrigin [expr {$_padX + 2}]
|
|
set _labelYOrigin [expr {$_labelHeight - $_padY}]
|
|
set _just left
|
|
}
|
|
default {
|
|
error "bad anchor position: \
|
|
\"$tabpos\" must be n, ne, nw, s, sw, se, e, w, or center"
|
|
}
|
|
}
|
|
}
|