tabset.itk

linux 下的源代码分析阅读器 red hat公司新版

#
# 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: [e-mail]
#
#  @(#) $Id: tabset.itk 144 2003-02-05 10:56:26Z mdejong $
# ----------------------------------------------------------------------
#            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
# ------------------------------------------------------------------
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} 
    
    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
# ----------------------------------------------------------------------
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> \
	    [code $this _canvasReconfigure %w %h]
    
    # ... Allow button 2 scrolling as in label widget.
    if {$tcl_platform(os) != "HP-UX"} {
	bind $itk_component(canvas) <2>               \
	    [code $this _startMove %x %y]
	bind $itk_component(canvas) <B2-Motion>       \
	    [code $this _moveTabs %x %y]
	bind $itk_component(canvas) <ButtonRelease-2> \
	    [code $this _endMove %x %y]
    }
    
    # @@@ 
    # @@@ Is there a better way?
    # @@@
    bind $itk_component(hull) <Any-Enter> "focus $itk_component(hull)"
    bind $itk_component(hull) <Tab> [code $this next]
    bind $itk_component(hull) <Shift-Tab> [code $this prev]
    
    eval itk_initialize $args
    
    _configRelayout 
    
    _recalcCanvasGeom
    
}

body iwidgets::Tabset::destructor {} {
    foreach tab $_tabs {
	itcl::delete object $tab
    }
}

# ----------------------------------------------------------------------
#                              OPTIONS
# ----------------------------------------------------------------------

# ----------------------------------------------------------------------
# OPTION -width
#
# Sets the width explicitly for the canvas of the tabset
# ----------------------------------------------------------------------
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.
# ----------------------------------------------------------------------
configbody iwidgets::Tabset::equaltabs {
    if {$itk_option(-equaltabs) != {}} {
	set _relayout true
    }
}

# ----------------------------------------------------------------------
# OPTION -height
#
# Sets the height explicitly for the canvas of the tabset
# ----------------------------------------------------------------------
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
# ----------------------------------------------------------------------
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
# ----------------------------------------------------------------------
configbody iwidgets::Tabset::raiseselect {
    if {$itk_option(-raiseselect) != {}} {
	set _relayout true
    }
}

# ----------------------------------------------------------------------
# OPTION -start
#
# Sets the offset to start of tab set
# ----------------------------------------------------------------------
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
# ----------------------------------------------------------------------
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)
# ----------------------------------------------------------------------
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.
# ----------------------------------------------------------------------
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.
# ----------------------------------------------------------------------
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.
# ----------------------------------------------------------------------
configbody iwidgets::Tabset::pady {
    if {$itk_option(-pady) != {}} {
	_tabConfigure -pady $itk_option(-pady)
    }
}

# ----------------------------------------------------------------------
# OPTION -gap
#
# Sets the amount of spacing between tabs in pixels
# ----------------------------------------------------------------------
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
# ----------------------------------------------------------------------
configbody iwidgets::Tabset::angle {
    if {$itk_option(-angle) != {}} {
	_tabConfigure -angle $itk_option(-angle)
    }
}

# ----------------------------------------------------------------------
# OPTION -font
#
# Sets the font of the tab (SELECTED and UNSELECTED)
# ----------------------------------------------------------------------
configbody iwidgets::Tabset::font {
    if {$itk_option(-font) != {}} {
	_tabConfigure -font $itk_option(-font)
    }
}

# ----------------------------------------------------------------------
# OPTION -state
# ----------------------------------------------------------------------
configbody iwidgets::Tabset::state {
    if {$itk_option(-state) != {}} {
	_tabConfigure -state $itk_option(-state)