path: root/vendor/x11iraf/guidemo/table.gui

# TABDEMO.GUI -- Test the Table widget.

reset-server
appInitialize tabdemo Tabdemo {

    *demoObjects:\
    	toplevel		Layout		panel \
    	panel			Frame		panelMenuFrame \
	panelMenuFrame		Layout		panelMenuBar \
	panelMenuBar		Command		newCol \
	panelMenuBar		Command		newRow \
	panelMenuBar		Command		newTable \
	panelMenuBar		Command		tclShell \
	panelMenuBar		Command		quitButton


	Tabdemo*background:			grey
	*Tabdemo.geometry:			+0+0

	*Group.shrinkToFit:                 	True
	*Command.height:			28
	*Command.shadowWidth:			1
	*Frame.frameWidth:			1
	*Frame.innerOffset:			4
	*Frame.highlightThickness:		0
	*borderWidth:				0
	*Scrollbar2.location:			0 0 17 17
	*Scrollbar.beNiceToColormap:		False

	*panel.width:				600
	*panel.height:				350
	*panel.layout: vertical { \
	    panelMenuFrame < +inf -inf * > \
	    5 < +inf > horizontal { 5 < +inf > }\
	}

	*panelMenuBar.layout: horizontal { \
	    2 newRow 1 newCol 1 newTable 1 tclShell 2 < +inf > quitButton 2 \
	}
	*newCol.label:				New Col
	*newRow.label:				New Row
	*newTable.label:			New Table
	*tclShell.label:			TclShell
	*quitButton.label:			Quit

} ; createObjects demoObjects

send quitButton addCallback "send client gkey q ; deactivate unmap"

# Utility procedure to test True/False strings in resources.
proc true {v} {expr {$v == "true" || $v == "True" || $v == "TRUE"}}

# Utility functions.
proc min {a b} { expr {($a < $b) ? $a : $b} }
proc max {a b} { expr {($a > $b) ? $a : $b} }

# Create the Table objects in the OBM.

set tabnumber	0				;# initialize table counter

proc doTable args {
    global  tabnumber

    set tab  [ format "tab%d" $tabnumber ] 
    set objs [ tableBuildObjects panel $tab ]

#   tableSetOption $tab DefLabels  no
#   tableSetOption $tab RowLabels  no
#   tableSetOption $tab ColLabels  no
#   tableSetOption $tab Tracking   no
#   tableSetOption $tab RowScroll  no
#   tableSetOption $tab ColScroll  no
#   tableSetOption $tab DefaultTranslations  no
    tableSetOption $tab RowMultiSelect  no
    tableSetOption $tab ColMultiSelect  no
#   tableSetOption $tab RowLabelCols 2
#   tableSetOption $tab ColLabelRows 2
    tableSetOption $tab Background  bisque3

    # Now create the new objects.
    appExtend $objs
    createObjects ${tab}Objects

    # Now construct a layout for the new object.
    set new ""
    set panStart "vertical \{ panelMenuFrame < +inf -inf * > 5 < -5 >"
    for {set i 0} {$i <= $tabnumber} {incr i} {

	# Send the existing table a small height so they'll ajust to 
	# fit the new table.
	if {$i < $tabnumber} { send tab${i}TableFrame set height 10 }

	# Append a layout spec for the table.
	set new \
	    [format "%s tab%dTableFrame < +inf -inf * +inf -inf > 5 < -5 >" \
	        $new $i]
    }
    set panEnd   "\}"
    set panelLayout [format "%s %s %s" $panStart $new $panEnd]

    # Send the panel the new layout incorporating the newly created Table.
    send panel set layout $panelLayout

    # Now create the table itself, it should appear as if by magic.
    tableCreate $tab 12 30 { }

    # Apply some default test callbacks for selection/edit events.
    tableAddSelectCallback $tab Row demoSelCB
    tableAddSelectCallback $tab Col demoSelCB
    tableAddSelectCallback $tab Cell demoSelCB
    tableAddUnSelectCallback $tab Row demoUnSelCB
    tableAddUnSelectCallback $tab Col demoUnSelCB
    tableAddUnSelectCallback $tab Cell demoUnSelCB
    tableAddEditCallback $tab demoEditCB

    # Increment the global table counter.
    incr tabnumber

} ; send newTable addCallback doTable

proc demoSelCB { name row col x y args } {
    print "demoSelCB:  name=$name r=$row c=$col x=$x y=$y args='$args'"
}

proc demoUnSelCB { name row col x y args } {
    print "demoUnSelCB:  name=$name r=$row c=$col x=$x y=$y args='$args'"
}

proc demoEditCB { name row col str args } {
    print "demoEditCB:  name=$name row=$row col=$col str='$str' args='$args'"
}


################################################################################

################################################################################
#
#  TABLE WIDGET PROCEDURES -- This interface provides simple access to a
#  named instance of a Table "meta-widget".  The "widget" is actually a
#  number of widgets (Table, Scrollbars, etc) in a common layout to provide
#  row/col headings, scrollable data tables, and callbacks for [gs]etting
#  attributes.  The meta-widget is created on-the-fly with a given named
#  and parent object, it is the callers responsibility to adjust the layout
#  of the parent to incorporate the new objects.
#
#	The Table widget itself has various quirks and non-standard implem-
#  entations so features such as editing cells or access to certain callbacks
#  are not fully implemented in the OBM and hidden here.  Most of what's
#  needed can be handled by these procedures, however these routines may be
#  used to manage multiple named tables in a GUI.
#
#
#	           tableBuildObjects  parent tab
#	              tableSetOption  tab option value
#             tableAddSelectCallback  tab type cbname
#               tableAddEditCallback  tab cbname
#	         tableDestroyObjects  tab
#
#		         tableCreate  tab nrows ncols data
#	                tableSetData  tab data
#	        tableSetColumnLabels  tab labels
#	           tableSetRowLabels  tab labels
#
#                     tableSelectRow  tab [ rownum | "all" ]
#                   tableUnSelectRow  tab [ rownum | "all" ]
#                     tableSelectCol  tab [ colnum | "all" ]
#                   tableUnSelectCol  tab [ colnum | "all" ]
#                    tableSelectCell  tab x y
#                  tableUnSelectCell  tab x y
#            list = tableGetSelected  tab type
#
#              tableSetRowLabelsAttr  tab attr value
#      value = tableGetRowLabelsAttr  tab attr
#              tableSetColLabelsAttr  tab attr value
#      value = tableGetColLabelsAttr  tab attr
#               tableSetRowLabelAttr  tab row attr value
#       value = tableGetRowLabelAttr  tab row attr
#               tableSetColLabelAttr  tab col attr value
#       value = tableGetColLabelAttr  tab col attr
#
#           attr = tableGetCelllAttr  tab row col attr
#                  tableSetCelllAttr  tab row col attr value
#            value = tableGetRowAttr  tab row attr
#                    tableSetRowAttr  tab row attr value
#            value = tableGetColAttr  tab col attr
#                    tableSetColAttr  tab col attr value
#
#                     tableDeleteCol  tab col 
#                     tableDeleteRow  tab row 
#                        tableAddCol  tab col width [where]
#                        tableAddRow  tab row [where]
#
#              nrows = tableGetNrows  tab
#              ncols = tableGetNcols  tab
#            height = tableGetHeight  tab
#              width = tableGetWidth  tab
#
#      See obm$widget.c for a complete list of the OBM commands available
#  for this widget, and procedure header comments for details about the 
#  interface here.
#
################################################################################

set tabNrows(name) 			0
set tabNcols(name) 			0
set tabData(name) 			0
set tabColLabs(name)			0
set tabRowHeights(name,j)		0
set tabColWidths(name,i) 		0

set tabHeight(name)			0
set tabWidth(name)			0
set tabScrollSize(name,type)		0
set tabScrollPos(name,type)		0

# Meta-widget options, should be set before the tableCreate call.
set tabOption(name,RowLabels)		yes
set tabOption(name,ColLabels)		yes
set tabOption(name,DefLabels)		yes
set tabOption(name,Tracking)		yes
set tabOption(name,RowScroll)		yes
set tabOption(name,ColScroll)		yes
set tabOption(name,Editable)		yes
set tabOption(name,RowSelect)		yes
set tabOption(name,ColSelect)		no
set tabOption(name,CellSelect)		no
set tabOption(name,DefaultTranslations)	yes
set tabOption(name,Background)		grey
set tabOption(name,Foreground)		black
set tabOption(name,HighlightColor)	grey90
set tabOption(name,RowLabelCols)	1
set tabOption(name,ColLabelRows)	1

# Selection lists.
set tabSelected(name,Row)		{}
set tabSelected(name,Col)		{}
set tabSelected(name,Cell)		{}
set tabSelectionCB(name,Row)		{}
set tabSelectionCB(name,Col)		{}
set tabSelectionCB(name,Cell)		{}
set tabUnSelectionCB(name,Row)		{}
set tabUnSelectionCB(name,Col)		{}
set tabUnSelectionCB(name,Cell)		{}
set tabEditCB(name)			{}


# TABLEBUILDOBJECTS -- Utility routine to build the object list for the meta-
# widget.
#
#  Usage:	
#	    tableBuildObjects  <parent> <tab>

proc tableBuildObjects { parent tab } {

    set objDef {
	*TABObjects: \
	    PARENT           Frame       	TABTableFrame	\
            TABTableFrame    Layout      	TABFrameLayout	\
            TABFrameLayout   Layout      	TABTableLayout	\
            TABTableLayout   Viewport    	TABTabView	\
            TABTabView       Table       	TABTab		\
            TABTableLayout   Label       	TABSpacer1      \
            TABTableLayout   Viewport    	TABRowTabView	\
            TABRowTabView    Table       	TABRowTab	\
            TABTableLayout   Viewport    	TABColTabView	\
            TABColTabView    Table       	TABColTab	\
            TABFrameLayout   Label       	TABLabel       	\
            TABFrameLayout   Label       	TABSpacer2      \
            TABFrameLayout   Scrollbar   	TABColScroll   	\
            TABFrameLayout   Scrollbar   	TABRowScroll	\
\
	    toplevel         TopLevelShell   	TABEditShell	\
	    TABEditShell     Layout          	TABEditLayout	\
	    TABEditLayout    Frame           	TABEditMenuFrame\
	    TABEditMenuFrame Layout          	TABEditMenuBar	\
	    TABEditMenuBar   Command         	TABEditApply	\
	    TABEditMenuBar   Command         	TABEditClear	\
	    TABEditMenuBar   Command         	TABEditCancel	\
	    TABEditLayout    Frame           	TABEditFrame	\
	    TABEditFrame     AsciiText       	TABEditText	\




        ! Global Table widget resources.
        *Table.literalWidth:                    	20
        *Table.rowHeight:                       	18
        *Table.shadowWidth:                     	2
        *Table.labelShadowWidth:                	1
        *Table.tableMargin:                     	0
        *Table.columnMargin:                     	0
        *Table.rowMargin:                     		0
        *Table.internalHeight:                  	0
        *Table.internalWidth:                   	0
        *Table*font:					7x13bold

        *TABTableFrame*Group.shrinkToFit:               True
        *TABTableFrame*Command.height:                  28
        *TABTableFrame*Command.shadowWidth:             1
        *TABTableFrame*Frame.frameWidth:                1
        *TABTableFrame*Frame.innerOffset:               4
        *TABTableFrame*Frame.highlightThickness:        0
        *TABTableFrame*Frame.borderWidth:               0
        *TABTableFrame*Frame.shrinkToFit:               True
        *TABTableFrame*Table.borderWidth:               1
        *TABTableFrame*Scrollbar.beNiceToColormap:      False

	*TABTableFrame.height:					10
	*TABTableFrame.width:					10
	*TABTableFrame*Layout.height:				10
	*TABTableFrame*Layout.width:				10
	*TABTableFrame*Label.height:				12
	*TABTableFrame*Label.label:
	*TABTableFrame*Label.font:				6x12

	*TABFrameLayout.TABTableLayout.height:			10
	*TABFrameLayout.TABTableLayout.width:			10
	*TABFrameLayout.TABTableLayout*Layout.height:		10
	*TABFrameLayout.TABTableLayout*Layout.width:		10
	*TABFrameLayout.TABTableLayout*Viewport.height:		20
	*TABFrameLayout.TABTableLayout*Viewport.width:		20
        *TABFrameLayout.TABTableLayout*Table.height:		20
        *TABFrameLayout.TABTableLayout*Table.width:		20


        ! The following resources enable the scrollbars on the Viewport
        ! widget but effectively hide them from display.  This allows us
        ! to control the viewport manually from the Table code, e.g. to
        ! scroll both the column headings and data table.
        *TABFrameLayout.TABTableLayout*Viewport.allowVert:      True
        *TABFrameLayout.TABTableLayout*Viewport.allowHoriz:     True
        *TABFrameLayout.TABTableLayout*Viewport.forceBars:      True
        *TABFrameLayout.TABTableLayout*Viewport.useBottom:      True
        *TABFrameLayout.TABTableLayout*Viewport.useRight:       True
        *TABFrameLayout.TABTableLayout*Viewport.borderWidth:    1

        *TABTableLayout*TABRowTabView*vertical.thickness:   	1
        *TABTableLayout*TABRowTabView*horizontal.thickness: 	1
        *TABTableLayout*TABColTabView*vertical.thickness:   	1
        *TABTableLayout*TABColTabView*horizontal.thickness: 	1
        *TABTableLayout*TABTabView*vertical.thickness:   	1
        *TABTableLayout*TABTabView*horizontal.thickness: 	1

        *TABTableFrame.TABFrameLayout.TABRowScroll.thickness:   12
        *TABTableFrame.TABFrameLayout.TABRowScroll.width:       12
        *TABTableFrame.TABFrameLayout.TABRowScroll.height:      12
        *TABTableFrame.TABFrameLayout.TABRowScroll.orientation: Vertical

        *TABTableFrame.TABFrameLayout.TABColScroll.thickness:   12
        *TABTableFrame.TABFrameLayout.TABColScroll.width:       12
        *TABTableFrame.TABFrameLayout.TABColScroll.height:      12
        *TABTableFrame.TABFrameLayout.TABColScroll.orientation: Horizontal

        *TABFrameLayout.layout: horizontal { \
	    vertical { \
		2 < -2 > \
                TABTableLayout < +inf -inf * +inf -inf > \
		2 < -2 > \
	        horizontal { \
		    TABLabel 1 < -1 > TABColScroll < +inf -inf * > \
	        } \
	    } \
	    vertical { \
		TABSpacer2 1 < -1 > TABRowScroll < * +inf -inf >  22 < -22 > \
	    } \
	}
	*TABTableFrame.TABFrameLayout.TABLabel.label: 		(  0,  0)
        *TABTableFrame.TABFrameLayout.TABLabel.font:            6x12
        *TABTableFrame.TABFrameLayout.TABLabel.width:           80
        *TABTableFrame.TABFrameLayout.TABLabel.height:          12
        *TABTableFrame.TABFrameLayout*TABColScroll.height:      12
        *TABTableFrame.TABFrameLayout.TABSpacer2.height:        27
        *TABTableFrame.TABFrameLayout.TABSpacer2.shadowWidth:   0

        *TABTableLayout.layout: horizontal { \
            vertical { \
                TABSpacer1 1 < -1 > TABRowTabView < * +inf -inf > \
            } \
            3 < -3 > \
            vertical { \
                TABColTabView < +inf -inf * > \
                3 < -3 > \
                TABTabView < +inf -inf * +inf -inf > \
            } \
            3 < -3 > \
        }	
	*TABTableLayout.TABSpacer1.height:	  		27
	*TABTableLayout.TABSpacer1.shadowWidth:	  		0

    !---------------------------+
    ! Set the editor resources. |
    !---------------------------+
    *TABEditShell.title:                          Table Value Editor
    *TABEditShell.width:                          275
    *TABEditShell.height:                         80
    *TABEditLayout*borderWidth:                   0
    *TABEditLayout.layout:  vertical { \
        TABEditFrame < +inf -inf * +inf -inf > \
        -2 \
        TABEditMenuFrame < +inf -inf * > \
        -2 \
    }

    *TABEditMenuBar.layout: horizontal { \
	TABEditApply 5 \
	10 < +inf -inf > \
	TABEditClear 5 \
	10 < +inf -inf > \
	TABEditCancel 5 \
    }
    *TABEditMenuFrame.height:                       80
    *TABEditMenuFrame.outerOffset:                  0
    *TABEditMenuFrame.innerOffset:                  5
    *TABEditMenuFrame.frameType:                    chiseled
    *TABEditMenuFrame.frameWidth:                   2
    *TABEditFrame.frameType:                        sunken
    *TABEditFrame.frameWidth:                       2
    *TABEditFrame.outerOffset:                      5
    *TABEditText*scrollVertical:                    never
    *TABEditText*scrollHorizontal:                  whenNeeded
    *TABEditText*font:                              7x13
    *TABEditText*editType:                          edit
    *TABEditApply.label:                            Apply
    *TABEditApply.width:                            150
    *TABEditClear.label:                            Clear
    *TABEditClear.width:                            150
    *TABEditCancel.label:                           Cancel
    *TABEditCancel.width:                           150

    }

    regsub -all TAB $objDef $tab tmp1
    regsub -all PARENT $tmp1 $parent objs
    set objs [format "{ %s }" $objs]

    return $objs
} 


# TABLEDESTROYOBJECTS -- Destroy the specified table and all it's objects.
#
#  Usage:	
#	    tableDestroyObjects  <tab>

proc tableDestroyObjects { tab } {
    destroyObject ${tab}TableFrame 
}


# TABESETOPTION -- Set an option for the Table meta-widget.
#
# Usage:
#		tableSetOption <tab> <option> [yes|no]
#
# where <tab> is the table name given when the meta-widget was created, and
# <option> is one of:
#
#
#    Option Name	    Type     Default	Description
#    -----------	    ----     -------	-----------
#    RowLabels		    bool     yes	display a row label table
#    ColLabels		    bool     yes	display a column label table
#    DefLabels		    bool     yes	do default labels of rows/cols
#    Tracking		    bool     yes	do coord tracking in data table
#    RowScroll		    bool     yes	display row scrollbar
#    ColScroll		    bool     yes	display column scrollbar
#    Editable		    bool     yes	table is editable
#    RowSelect		    bool     yes	rows are selectable
#    ColSelect		    bool     yes	cols are selectable
#    CellSelect		    bool     yes	cells are selectable
#    RowMultiSelect	    bool     yes	multiple rows may be selected
#    ColMultiSelect	    bool     yes	multiple cols may be selected
#    CellMultiSelect	    bool     yes	multiple cells may be selected
#    DefaultTranslations    bool     yes	use default table translations
#    Foreground		    color    black	meta-widget foreground color
#    Background		    color    grey	meta-widget background color
#    HighlightColor	    color    grey90	selected item highlight color
#    RowLabelCols	    int	     1		number of columns in row labels
#    ColLabelRows	    int	     1		number of rows in column labels
#

proc tableSetOption { tab option value } {
    global tabOption
    set tabOption(${tab},${option}) $value

    # Now handle the special cases where one option may disable some other.
}


# TABLEADDSELECTCALLBACK -- Add a user-defined callback to be executed
# when there is a row, column, or cell selection event occurs.
#
#  Usage:	
#	    tableAddSelectCallback  <tab> <type> <cbname>
#
# where <type> is "Row", "Col", or "Cell" and <cbname> specifies a procedure
# to be called whenever the specified <type> is selected.  Procedures are
# called as
#		<cbname> name row col x y
#
# where 'name' is the table name, 'row' and 'col' are the coordinates of the
# selection and 'x' and 'y' are the raw event coordinates.  Registered proc-
# edures are required to declare all these arguments but do not need to use
# them.

proc tableAddSelectCallback { tab type cbname } {
    global tabSelectionCB
    lappend tabSelectionCB(${tab},${type}) $cbname
}


# TABLEADDUNSELECTCALLBACK -- Add a user-defined callback to be executed
# when there is a row, column, or cell un-selection event occurs.
#
#  Usage:	
#	    tableAddUnSelectCallback  <tab> <type> <cbname>
#
# where <type> is "Row", "Col", or "Cell" and <cbname> specifies a procedure
# to be called whenever the specified <type> is selected.  Procedures are
# called as
#		<cbname> name row col x y state
#
# where 'name' is the table name, 'row' and 'col' are the coordinates of the
# selection and 'x' and 'y' are the raw event coordinates.  Registered proc-
# edures are required to declare all these arguments but do not need to use
# them.

proc tableAddUnSelectCallback { tab type cbname } {
    global tabUnSelectionCB
    lappend tabUnSelectionCB(${tab},${type}) $cbname
}



# TABLEADDEDITCALLBACK -- Add a user-defined callback to be executed
# when there is an edit event.
#
#  Usage:	
#	    tableAddEditCallback <tab> <cbname>
#
# <cbname> specifies a procedure to be called whenever the table editor 
# Apply button has been pressed.  Procedures are called as
#
#		<cbname> name row col new_string
#
# where 'name' is the table name, 'row' and 'col' are the coordinates of the
# edited cell and 'new_string' is the new value inserted in the table.  Reg-
# istered procedures are required to declare all these arguments but do not
# need to use them.

proc tableAddEditCallback { tab cbname } {
    global tabEditCB
    lappend tabEditCB(${tab}) $cbname
}


# TABLECREATE -- Create a named instance of the Table meta-widget.  The
# individual objects in the meta-widget are created dynamically and the
# entire thing is created as a child of the named parent object.  The
# standard callbacks are assigned and the table is initialized, however
# it is the callers responsibility to adjust the parent's layout to make
# the meta-widget visible and assign any constraint callbacks.
#
#  Usage:	
#	    tableCreate  <tab> <nrows> <ncols> <data>
#
# The <data> is specified as a Tcl list of the form:
#
#      { {r1c1 r1c2 ... r1cN}
#        {r2c1 r2c2 ... r2cN}
#              :
#        {rNc1 rNc2 ... rNcN} }
#
# String values must be quoted, rows/cols will be truncated or cleared if
# the specified table size does not agree with the size of the data table
# being loaded.

set tabBGWidgets { \
    TABTab TABRowTab TABColTab TABLabel TABColScroll \
    TABRowScroll TABEditApply TABEditClear TABEditCancel \
    TABEditApply TABEditClear TABEditCancel TABEditText \
    TABEditFrame TABEditMenuBar TABEditMenuFrame \
}
set tabFGWidgets { \
    TABTab TABRowTab TABColTab TABLabel TABColScroll \
    TABRowScroll TABEditApply TABEditClear TABEditCancel \
    TABEditApply TABEditClear TABEditCancel TABEditText \
}

proc tableCreate { tab nrows ncols data } {
    global tabNrows tabNcols tabRowHeights tabColWidths
    global tabHeight tabWidth tabDebug tabOption 
    global tabEditCB tabSelectionCB tabUnSelectionCB 
    global tabSelected tabBGWidgets tabFGWidgets

    set err ""
    catch {
        if { ![info exists tabOption(${tab},RowLabelCols)] } {
            set tabOption(${tab},RowLabelCols) $tabOption(name,RowLabelCols)
        }
    } err
    if {$err != ""} {
        set tabOption(${tab},RowLabelCols) $tabOption(name,RowLabelCols)
    }
    set err ""
    catch {
        if { ![info exists tabOption(${tab},ColLabelRows)] } {
            set tabOption(${tab},ColLabelRows) $tabOption(name,ColLabelRows)
        }
    } err
    if {$err != ""} {
        set tabOption(${tab},ColLabelRows) $tabOption(name,ColLabelRows)
    }

           
    set tabNrows(${tab},data)	$nrows
    set tabNcols(${tab},data) 	$ncols
    set tabNrows(${tab},rows) 	$nrows
    set tabNcols(${tab},rows) 	$tabOption(${tab},RowLabelCols)
    set tabNrows(${tab},cols) 	$tabOption(${tab},ColLabelRows)
    set tabNcols(${tab},cols) 	$ncols
    set tabData($tab)  		$data

    # Initialize with a default row height.
    set rh [send ${tab}Tab get rowHeight]
    set tabRowHeights($tab,default) $rh
    for {set i 1} {$i <= $nrows} {incr i} { 
	set tabRowHeights($tab,$i) $rh 
    }

    # Initialize with a default column width.
    set cw [send ${tab}Tab get defaultWidth]
    for {set i 1} {$i <= $ncols} {incr i} { 
	set tabColWidths($tab,$i) $cw 
    }

    # Initialize the table.
    send ${tab}Tab setTable $nrows $ncols $data

    # Initialize the labels.
    tableSetDefaultLabels $tab

    # Save the table dimensions.
    set tabHeight($tab) [ tableGetHeight $tab ]
    set tabWidth($tab)  [ tableGetWidth  $tab ]

    # Set the default table translations.
    tableSetDefaultTranslations $tab

    # Attach the default-callbacks to the new Table.
    tableAddCallbacks $tab

    # Set Default Scrollbars for the table.
    tableSetDefaultScrollbars $tab yes

    # Default the colors.
    set err ""
    catch { 
      if { ![info exists tabOption(${tab},HighlightColor)] != 0 } {
        set tabOption(${tab},HighlightColor) $tabOption(name,HighlightColor)
      }
    } err 
    if {$err != ""} {
        set tabOption(${tab},HighlightColor) $tabOption(name,HighlightColor)
    }
    set err ""
    catch { 
      if { ![info exists tabOption(${tab},Background)] != 0 } {
        set tabOption(${tab},Background)     $tabOption(name,Background)
      }
    } err 
    if {$err != ""} {
        set tabOption(${tab},Background)     $tabOption(name,Background)
    }
    set err ""
    catch { 
      if { ![info exists tabOption(${tab},Foreground)] != 0 } {
        set tabOption(${tab},Foreground)     $tabOption(name,Foreground)
      }
    } err
    if {$err != ""} {
        set tabOption(${tab},Foreground)     $tabOption(name,Foreground)
    }

    regsub -all TAB $tabBGWidgets $tab bgwidgets
    foreach w $bgwidgets { 
	send $w set background $tabOption(${tab},Background) 
    }
    regsub -all TAB $tabFGWidgets $tab fgwidgets
    foreach w $fgwidgets { 
	send $w set foreground $tabOption(${tab},Foreground)
    }

    # Default selections.
    set tabSelected(${tab},Row)		{}
    set tabSelected(${tab},Col)		{}
    set tabSelected(${tab},Cell)	{}

    set tabSelectionCB(${tab},Row) 	{}
    set tabSelectionCB(${tab},Col) 	{}
    set tabSelectionCB(${tab},Cell) 	{}
    set tabUnSelectionCB(${tab},Row) 	{}
    set tabUnSelectionCB(${tab},Col) 	{}
    set tabUnSelectionCB(${tab},Cell) 	{}
    set tabEditCB(${tab}) 		{}
}


# TABLESETDATA -- Set the data elements of a table meta-widget.
#
# Usage:
#		tableSetData  <tab> <data>
#
# where <tab> is the table name given when the meta-widget was created, and
# <data> is of the form:
#
#      { {r1c1 r1c2 ... r1cN}
#        {r2c1 r2c2 ... r2cN}
#              :
#        {rNc1 rNc2 ... rNcN} }

proc tableSetData { tab data } {
    global tabNrows tabNcols

    send ${tab}Tab setTable $tabNrows(${tab},data) $tabNcols(${tab},data) $data

#   send ${tab}Tab setTable \
#	[expr ($tabNrows(${tab},data) + 20)] \
#	[expr ($tabNcols(${tab},data) + 20)] \
#	$data
}


# TABLESETSIZE -- Set the size of a table meta-widget.
#
# Usage:
#               tableSetSize  <tab> <nrows> <ncols>
#

proc tableSetSize { tab nrows ncols } {
    global tabNrows tabNcols tabOption 
    global tabHeight tabWidth tabRowHeights

    set tabNrows(${tab},data)   $nrows
    set tabNcols(${tab},data)   $ncols

    set tabNrows(${tab},rows)   $nrows
    set tabNcols(${tab},rows)   $tabOption(${tab},RowLabelCols)
    set tabNrows(${tab},cols)   $tabOption(${tab},ColLabelRows)
    set tabNcols(${tab},cols)   $ncols

    send ${tab}Tab    setTableSize $nrows $ncols
    send ${tab}RowTab setTableSize $tabNrows(${tab},rows) $tabNcols(${tab},rows)
    send ${tab}ColTab setTableSize $tabNrows(${tab},cols) $tabNcols(${tab},cols)

    set rh [send ${tab}Tab get rowHeight]
    set tabRowHeights($tab,default) $rh
    for {set i 1} {$i <= $nrows} {incr i} { 
	set tabRowHeights($tab,$i) $rh 
    }

    # Save the table dimensions.
    set tabHeight($tab) [ tableGetHeight $tab ]
    set tabWidth($tab)  [ tableGetWidth  $tab ]

    #tableSetDefaultScrollbars $tab yes
}


# TABLESETCOLUMNLABELS -- Set the column header labels for a table.
# meta-widget.
#
# Usage:
#		tableSetColumnLabels  <tab> <column_labs>
#
# where <tab> is the table name given when the meta-widget was created, and
# <data> is of the form:
#
#      { { r1c1 } { r1c2 } ... { r1cN } }

proc tableSetColumnLabels { tab col_labs } {
    global tabNrows tabNcols
    send ${tab}ColTab \
	setTable $tabNrows(${tab},cols) $tabNcols(${tab},cols) $col_labs
}


# TABLESETROWLABELS -- Set the row header labels for a table.
# meta-widget.
#
# Usage:
#		tableSetColumnLabels  <tab> <row_labs>
#
# where <tab> is the table name given when the meta-widget was created, and
# <data> is of the form:
#
#      { {r1c1 r1c2 ... r1cN} }

proc tableSetRowLabels { tab row_labs } {
    global tabNrows tabNcols
    send ${tab}RowTab \
	setTable $tabNrows(${tab},rows) $tabNcols(${tab},rows) $row_labs
}


# TABLESETCOLLABELSATTR -- Set the column header labels for a table
# meta-widget.
#
# Usage:
#		tableSetColumnLabels  <tab> <attr> <value> [<row>]
#
# where <attr> is one of
#
#      background              background color
#      foreground              foreground color
#      width                   column width
#      justify		       label justification

proc tableSetColLabelsAttr { tab attr value args } {
    if {$args != ""} {
        send ${tab}ColTab setRowAttr $args $attr $value
    } else {
        send ${tab}ColTab setRowAttr 1 $attr $value
    }
}


# TABLESETROWLABELSATTR -- Set the row header labels for a table meta-widget.
#
# Usage:
#		tableSetRowLabelsAttr  <tab> <attr> <value> [<col>]
#
# where <attr> is one of
#
#      background              background color
#      foreground              foreground color
#      width	               column width
#      justify	               label justification

proc tableSetRowLabelsAttr { tab attr value args } {
    if {$args != ""} {
        send ${tab}RowTab setColAttr $args $attr $value
    } else {
        send ${tab}RowTab setColAttr 1 $attr $value
    }
}


# TABLEGETROWLABELSATTR -- Get the row header labels for a table meta-widget.
#
# Usage:
#		value = tableGetRowLabelsAttr  <tab> <attr> [<col>]
#
# where <attr> is one of
#
#      background              background color
#      foreground              foreground color
#      width	               column width
#      justify	               label justification

proc tableGetRowLabelsAttr { tab attr args } {
    if {$args != ""} {
        return [ send ${tab}RowTab getColAttr $args $attr ]
    } else {
        return [ send ${tab}RowTab getColAttr 1 $attr ]
    }
}


# TABLEGETCOLLABELSATTR -- Get the column header labels for a table.
# meta-widget.
#
# Usage:
#		value = tableGetColLabelsAttr  <tab> <attr> [<row>]
#
# where <attr> is one of
#
#      background              background color
#      foreground              foreground color
#      width                   column width
#      justify		       label justification

proc tableGetColLabelsAttr { tab attr args } {
    if {$args != ""} {
        return [ send ${tab}ColTab getRowAttr $args $attr ]
    } else {
        return [ send ${tab}ColTab getRowAttr 1 $attr ]
    }
}


# TABLESETROWLABELATTR -- Set the specified attribute for the row label table.
#
# Usage:
#         tableSetRowLabelAttr  <tab> <row> <attr> <value> [<row>]
#
# The cell position is given as a 1-indexed array element where the UL
# of the table is cell (1,1).  Allowed attributes for a cell include:
#
#              label                   label text (string)
#              background              background color (string)
#              foreground              foreground color (string)

proc tableSetRowLabelAttr { tab row attr value args } {
    if {$args != ""} {
        send ${tab}RowTab setCellAttr $row $args $attr $value
    } else {
        send ${tab}RowTab setCellAttr $row 1 $attr $value
    }
}


# TABLESETCOLLABELATTR -- Get the specified attribute for the col label table.
#
# Usage:
#        value = tableSetColLabelAttr  <tab> <col> <attr> <value> [<row>]
#
# The cell position is given as a 1-indexed array element where the UL
# of the table is cell (1,1).  Allowed attributes for a cell include:
#
#              label                   label text (string)
#              background              background color (string)
#              foreground              foreground color (string)

proc tableSetColLabelAttr { tab col attr value args } {
    if {$args != ""} {
        send ${tab}ColTab setCellAttr $args $col $attr $value
    } else {
        send ${tab}ColTab setCellAttr 1 $col $attr $value
    }
}


# TABLEGETCELLATTR -- Get the specified attribute for the cell.
#
# Usage:
#		value = tableGetCellAttr  <tab> <row> <col> <attr>
#
# The cell position is given as a 1-indexed array element where the UL
# of the table is cell (1,1).  Allowed attributes for a cell include:
#
#              label                   label text (string)
#              background              background color (string)
#              foreground              foreground color (string)

proc tableGetCellAttr { tab row col attr } {
    return [ send ${tab}Tab getCellAttr $row $col $attr ]
}


# TABLESETCELLATTR -- Set the specified attribute for the cell.
#
# Usage:
#		tableSetCellAttr  <tab> <row> <col> <attr> <value>
#
# The cell position is given as a 1-indexed array element where the UL
# of the table is cell (1,1).  Allowed attributes for a cell include:
#
#              label                   label text (string)
#              background              background color (string)
#              foreground              foreground color (string)

proc tableSetCellAttr { tab row col attr value } {
    send ${tab}Tab setCellAttr $row $col $attr $value
}


# TABLEGETROWATTR -- Get the specified attribute for the row.
#
# Usage:
#		value = tableGetCellAttr  <tab> <row> <attr>
#
# The row position is given as a 1-indexed array element where the UL
# of the table is cell (1,1).  Allowed attributes for a row include:
#
#      background              background color
#      foreground              foreground color

proc tableGetRowAttr { tab row attr } {
    return [ send ${tab}Tab getRowAttr $row $attr ]
}


# TABLESETROWATTR -- Set the specified attribute for the row.
#
# Usage:
#		tableSetRowAttr  <tab> <row> <attr> <value>
#
# The row position is given as a 1-indexed array element where the UL
# of the table is cell (1,1).  Allowed attributes for a row include:
#
#      background              background color
#      foreground              foreground color

proc tableSetRowAttr { tab row attr value } {
    send ${tab}Tab setRowAttr $row $attr $value
}


# TABLEGETCOLATTR -- Get the specified attribute for the column.
#
# Usage:
#		value = tableGetColAttr  <tab> <col> <attr>
#
# The column position is given as a 1-indexed array element where the UL
# of the table is cell (1,1).  Allowed attributes for a column include:
#
#              width                   column width (pixels)
#              background              background color (string)
#              foreground              foreground color (string)
#              justify                 text justification (string)

proc tableGetColAttr { tab col attr } {
    return [ send ${tab}Tab getColAttr $col $attr ]
}


# TABLESETCOLATTR -- Set the specified attribute for the column.
#
# Usage:
#		tableSetColAttr  <tab> <col> <attr> <value>
#
# The column position is given as a 1-indexed array element where the UL
# of the table is cell (1,1).  Allowed attributes for a column include:
#
#              width                   column width (pixels)
#              background              background color (string)
#              foreground              foreground color (string)
#              justify                 text justification (string)

proc tableSetColAttr { tab col attr value } {
    global tabColWidths tabNcols

    send ${tab}Tab setColAttr $col $attr $value
    if {$attr == "width"} { 
	set tabColWidths(${tab},$col) $value 
    }
}


# TABLEDELETECOL -- Delete the specified column from the named table.
#
# Usage:
#		tableDeleteCol  <tab> <col>

proc tableDeleteCol { tab col } {
    global tabColWidths tabNcols

    send ${tab}Tab    deleteCol $col
    send ${tab}ColTab deleteCol $col
    incr tabNcols(${tab},data) -1
    catch { unset tabColWidths(${tab},$col) } err
}


# TABLEDELETEROW -- Delete the specified row from the named table.
#
# Usage:
#		tableDeleteRow  <tab> <row>

proc tableDeleteRow { tab row } {
    global tabRowHeights tabNrows 

    send ${tab}Tab    deleteRow $row
    send ${tab}RowTab deleteRow $row
    incr tabNrows(${tab},data) -1
    catch { unset tabRowHeights(${tab},$row) } err
}


# TABLEDADDCOL -- Add a column to the named table at the specified position.
#
# Usage:
#		tableAddCol  <tab> <col> <width>

proc tableAddCol { tab col width args} {
    global tabColWidths tabNcols

    send ${tab}Tab    addCol $col $width $args
    send ${tab}ColTab addCol $col $width $args
    incr tabNcols(${tab},data)

    set ncols $tabNcols(${tab},data)
    if {$col == "first"} {
	set colnum 1
    } elseif {$col == "last"} {
	set colnum $tabNcols(${tab},data)
    } else {
	set colnum $col
    }

    # Update the column widths.
    for {set c $ncols} {$c > $colnum} {incr c -1} {
        set tabColWidths(${tab},$c) $tabColWidths(${tab},[expr ($c - 1)])
    }
    set tabColWidths(${tab},$colnum) $width
}


# TABLEADDROW -- Add a rows to the named table at the specified position.
#
# Usage:
#		tableAddRow  <tab> <row>

proc tableAddRow { tab row args } {
    global tabRowHeights tabNrows 

    send ${tab}Tab    addRow $row $args
    send ${tab}RowTab addRow $row $args
    incr tabNrows(${tab},data)
    set tabRowHeights(${tab},$row) $tabRowHeights(${tab},default)
}


# TABLEGETNROWS -- Return the number of rows in a named table.
#
# Usage:
#		nrows = tableGetNrows  <tab>

proc tableGetNrows { tab } { 
    global tabNrows
    return $tabNrows(${tab},data)
}


# TABLEGETNCOLS -- Return the number of columns in a named table.
#
# Usage:
#		ncols = tableGetNcols  <tab>

proc tableGetNcols { tab }  { 
    global tabNcols
    return $tabNcols(${tab},data)
}


# TABLEGETHEIGHT -- Compute the height of the table given varying row heights.
#
# Usage:
#		height = tableGetHeight  <tab>

proc tableGetHeight { tab } { 
    return  [ send ${tab}Tab get height ]
}


# TABLEGETWIDTH -- Compute the width of the table given varying column widths.
#
# Usage:
#		width = tableGetWidth  <tab>

proc tableGetWidth { tab }  { 
    return  [ send ${tab}Tab get width ]
}


# TABLEGETSELECTED -- Return a list of the selected items.
#
# Usage:	list = tableGetSelected  tab type
#
# where <type> is 'Row', 'Col', or 'Cell'.

proc tableGetSelected { tab type } {
    global tabSelected
    return $tabSelected(${tab},${type})
}



# TABLESELECTROW -- User-selectable row procedure.  Row may be the string
# "all" in which case we select all rows in the table, otherwise may sure
# selection is unique.

proc tableSelectRow { tab row } {
    global tabSelected tabOption tabNrows

    set color $tabOption(${tab},HighlightColor)
    if {$row == "all"} {
	for {set i 0} {$i < $tabNrows(${tab},data)} {incr i} {
            set index [lsearch $tabSelected(${tab},Row) $row ]
	    if {$index < 0} {
	        lappend tabSelected(${tab},Row) $i
	        tableSetRowAttr ${tab} $i background $color
	        tableSetRowAttr ${tab}Row $i background $color
	    }
	}
    } else {
        set index [lsearch $tabSelected(${tab},Row) $row ]
	if {$index < 0} {
	    lappend tabSelected(${tab},Row) $row
	    tableSetRowAttr ${tab} $row background $color
	    tableSetRowAttr ${tab}Row $row background $color
	}
    }
}


# TABLESELECTCOL -- User-selectable column procedure.  Col may be the string
# "all" in which case we select all cols in the table, otherwise may sure
# selection is unique.

proc tableSelectCol { tab col } {
    global tabSelected tabOption tabNcols

    set color $tabOption(${tab},HighlightColor)
    if {$col == "all"} {
	for {set i 0} {$i < $tabNcols(${tab},data)} {incr i} {
            set index [lsearch $tabSelected(${tab},Col) $col ]
	    if {$index < 0} {
	        lappend tabSelected(${tab},Col) $i
	        tableSetColAttr ${tab} $i background $color
	        tableSetColAttr ${tab}Col $i background $color
	    }
	}
    } else {
        set index [lsearch $tabSelected(${tab},Col) $col ]
	if {$index < 0} {
	    lappend tabSelected(${tab},Col) $col
	    tableSetRowAttr ${tab} $col background $color
	    tableSetRowAttr ${tab}Col $col background $color
	}
    }
}


# TABLESELECTCELL -- User-callable cell selection procedure

proc tableSelectCell { tab col row } {
    global tabSelected tabOption

    set color $tabOption(${tab},HighlightColor)
    set index [lsearch $tabSelected(${tab},Col) [list $row $col] ]
    if {$index < 0} {
        lappend tabSelected(${tab},Cell) [list $row $col]
        tableSetCellAttr ${tab} $row $col background $color
    }
}


# TABLEUNSELECTROW -- Deselect the specified row.

proc tableUnSelectRow { tab row } {
    global tabSelected tabOption tabNrows

    set color $tabOption(${tab},Background)
    if {$row == "all"} {
	for {set i 0} {$i < $tabNrows(${tab},data)} {incr i} {
            set index [lsearch $tabSelected(${tab},Row) $i ]
	    if {$index >= 0} {
                set tabSelected(${tab},Row) \
                    [ lreplace $tabSelected(${tab},Row) $index $index ]
	        tableSetRowAttr ${tab} $i background $color
	        tableSetRowAttr ${tab}Row $i background $color
	    }
	}
    } else {
        # Delete it from the list.
        set index [lsearch $tabSelected(${tab},Row) $row ]
	if {$index >= 0} {
            set tabSelected(${tab},Row) \
                [ lreplace $tabSelected(${tab},Row) $index $index ]
            tableSetRowAttr ${tab} $row background $color
            tableSetRowAttr ${tab}Row $row background $color
	}
    }
}


# TABLEUNSELECTCOL -- Deselect the specified col.

proc tableUnSelectCol { tab col } {
    global tabSelected tabOption tabNrows

    set color $tabOption(${tab},Background)
    if {$col == "all"} {
	for {set i 0} {$i < $tabNcols(${tab},data)} {incr i} {
            set index [lsearch $tabSelected(${tab},Col) $i ]
	    if {$index >= 0} {
                set tabSelected(${tab},Col) \
                    [ lreplace $tabSelected(${tab},Col) $index $index ]
	        tableSetColAttr ${tab} $i background $color
	        tableSetColAttr ${tab}Col $i background $color
	    }
	}
    } else {
        # Delete it from the list.
        set index [lsearch $tabSelected(${tab},Col) $col ]
	if {$index >= 0} {
            set tabSelected(${tab},Col) \
                [ lreplace $tabSelected(${tab},Col) $index $index ]
            tableSetColAttr ${tab} $col background $color
            tableSetColAttr ${tab}Col $col background $color
	}
    }
}


# TABLEUNSELECTCELL -- Deselect the specified cell.

proc tableUnSelectCell { tab col row } {
    global tabSelected tabOption

    set val   [list $row $col]
    set index [lsearch $tabSelected(${tab},Cell) $val ]
    set color $tabOption(${tab},Background)

    # Delete it from the list.
    if {$index >= 0} {
        set tabSelected(${tab},Cell) \
            [ lreplace $tabSelected(${tab},Cell) $index $index ]
        tableSetCellAttr ${tab} $row $col background $color
    }
}



#==============================================================================
# TABLEDIT -- Enable the cell editor
#==============================================================================

set tabEditRow		0
set tabEditCol		0
set tabEditValue	""

set tableEditorUp	0

proc tableEdit { name x y } {
    global tabEditValue tabEditRow tabEditCol tableEditCB, tableEditorUp

    regsub Tab $name "" tab

    set ry [tablePos2CellY $tab $y]
    set rx [tablePos2CellX $tab $x]

    if {$rx < 0 || $ry < 0} \
	return
	
    set newcell 0
    if {$tabEditRow != $rx || $tabEditCol != $ry} {
	set newcell 1
    }

    set tabEditCol   [tablePos2CellX $tab $x]
    set tabEditRow   [tablePos2CellY $tab $y]
    set tabEditValue [tableGetCellAttr $tab $tabEditRow $tabEditCol label]

    if {$tableEditorUp == 0 || $newcell == 1} {
        send ${tab}EditApply  addCallback tableEditApply
        send ${tab}EditCancel addCallback tableEditCancel
        send ${tab}EditClear  addCallback tableEditClear
        send ${tab}EditText   addCallback tableEditLoad
        send ${tab}EditText set string $tabEditValue
        send ${tab}EditShell move $x [expr ($y + 50)]
        send ${tab}EditShell map
	set tableEditorUp 1
    } else {
        send ${tab}EditApply  deleteCallback tableEditApply
        send ${tab}EditCancel deleteCallback tableEditCancel
        send ${tab}EditClear  deleteCallback tableEditClear
        send ${tab}EditText   deleteCallback tableEditLoad
        send ${tab}EditShell  unmap
	set tableEditorUp 0
    }
}

proc tableEditApply { button args } {
    global tabEditValue tabEditRow tabEditCol tabEditCB tabEditorUp
    regsub EditApply $button "" tab

    set str [send ${tab}EditText get string]

    tableSetCellAttr $tab $tabEditRow $tabEditCol label $str
    set tabEditValue $str

    # Now do the user-defined selection callbacks.
    if { [llength $tabEditCB(${tab})] > 0} {
        foreach cb $tabEditCB(${tab}) {$cb $tab $tabEditRow $tabEditCol "$str"}
    }

    # Close the window.
    send ${tab}EditApply  deleteCallback tableEditApply
    send ${tab}EditCancel deleteCallback tableEditCancel
    send ${tab}EditClear  deleteCallback tableEditClear
    send ${tab}EditText   deleteCallback tableEditLoad
    send ${tab}EditShell  unmap
    set tableEditorUp 0
}

proc tableEditLoad { widget mode pattern args } {
    regsub EditText $widget "" tab
    tableEditApply ${tab}EditApply
}

proc tableEditClear { button args } { 
    global tabEditValue

    regsub EditClear $button "" tab
    send ${tab}EditText set string ""
}

proc tableEditCancel { button args } { 
    global tableEditValue tableEditorUp

    regsub EditCancel $button "" tab
    send ${tab}EditShell unmap
    send ${tab}EditApply  deleteCallback tableEditApply
    send ${tab}EditCancel deleteCallback tableEditCancel
    send ${tab}EditClear  deleteCallback tableEditClear
    send ${tab}EditText   deleteCallback tableEditLoad
    set tableEditorUp 0
}


###############################################################################
#
# Private Procedures
#
###############################################################################


# TABLEADDCALLBACKS -- Add the default widget callbacks. 

proc tableAddCallbacks { tab } {

    # Attach the scrollbars actions.
    if {[ tableOption $tab RowScroll] == "yes"} {
        send ${tab}RowScroll addCallback tableJumpScroll
    } else {
        send ${tab}RowScroll "unmap ; set width 0"
    }

    if {[ tableOption $tab ColScroll] == "yes"} {
        send ${tab}ColScroll addCallback tableJumpScroll
    } else {
        send ${tab}Label set height 0
        send ${tab}ColScroll "unmap ; set height 0"
    }

    if {[tableOption $tab Tracking] == "no"} {
	send ${tab}Label set label ""
	send ${tab}Label set width 50
    }

    # Setup a resize handler that will adjust the scrollbars/viewports.
    send ${tab}TableFrame addEventHandler tableResizeHandler structureNotifyMask
}


# TABLERESIZEHANDLER -- Resize callbacks, called as an eventHandler when
# the parent window or the table meta-widget changes size.  All we need to
# do here is reset the scrollbars to reflect the new size.

proc tableResizeHandler { table args } { 
    regsub TableFrame $table "" tab
    #tableSetDefaultScrollbars $tab no
    tableSetDefaultScrollbars $tab yes
}


# TABLETRACK -- Track the motion in the table.

proc tableTrack { name x y } {
    regsub Tab $name "" tab
    if {[ tableOption $tab Tracking] == "no"} {
	return
    }

    set nr  [tableGetNrows $tab]
    set nc  [tableGetNcols $tab]
    set col [tablePos2CellX $tab $x]
    set row [tablePos2CellY $tab $y]
    if {$col < 0 || $row < 0} {
        send ${tab}Label set label "         "
    } else {
        send ${tab}Label set label [ format "(%3d,%3d)" $row $col ]
    } 
}


# TABLESELECT -- Do the default selection callback which applies to rows,
# columns and cells.

proc tableSelect { name type x y } {
    global tabOption tabSelected tabSelectionCB tabUnSelectionCB


    regsub Row $name  "" rc
    regsub Col $name  "" cc

    if {$type == "Row"} {
        if {$rc == $name || [ tableOption $name RowSelect ] == "no"} \
	    return
        regsub ${type}Tab $name "" tab
        set col [tablePos2CellX $tab $x]
        set row [tablePos2CellY $tab $y]
        set val $row
    } elseif {$type == "Col"} {
        if {$cc == $name || [ tableOption $name ColSelect ] == "no"} \
	    return
        regsub ${type}Tab $name "" tab
        set col [tablePos2CellX $tab $x]
        set row [tablePos2CellY $tab $y]
        set val $col
    } elseif {$type == "Cell"} {
        if {$rc != $name && $cc != $name} \
	    return
        if {[ tableOption $name CellSelect ] == "no"} \
	    return
        regsub Tab $name "" tab
        set col [tablePos2CellX $tab $x]
        set row [tablePos2CellY $tab $y]
        set val [list $row $col]
    }
    
    if {$col < 0 || $row < 0} \
	return

    set index [ lsearch $tabSelected(${tab},${type}) $val ]
    set color $tabOption(${tab},HighlightColor)
	
    # If we're doing a radio selection, turn off anything already selected.
    
    if {[ tableOption $tab ${type}MultiSelect] == "no"} {
	if { [llength $tabSelected(${tab},${type})] == 1} {
            tableSet${type}Attr ${tab} \
		[lindex $tabSelected(${tab},${type}) 0] \
	        background $tabOption(${tab},Background)
            tableSet${type}Attr ${tab}${type} \
		[lindex $tabSelected(${tab},${type}) 0] \
	        background $tabOption(${tab},Background)

	    # Now do the user-defined un-selection callbacks.
	    if { [llength $tabUnSelectionCB(${tab},${type})] > 0} {
	        foreach cb $tabUnSelectionCB(${tab},${type}) { 
		    $cb $tab $row $col $x $y 0
		}
	    }

	    set tabSelected(${tab},${type}) [list $val ]

	    if {$type == "Row"} {
		foreach c $tabSelected(${tab},Col) {
                    tableSetColAttr ${tab} $c background $color
		}
	    } elseif {$type == "Col"} {
		foreach c $tabSelected(${tab},Row) {
                    tableSetRowAttr ${tab} $c background $color
		}
	    }
	} else {
            lappend tabSelected(${tab},${type}) $val
	}
    } else {
        if { $index < 0} {
            lappend tabSelected(${tab},${type}) $val
	}
    }

    # If this has already been selected, toggle it.
    if { $index >= 0} {
	if {$type != "Cell"} {
            tableSet${type}Attr ${tab} \
	        [lindex $tabSelected(${tab},${type}) $index] \
	        background $tabOption(${tab},Background)
            tableSet${type}Attr ${tab}${type} \
	        [lindex $tabSelected(${tab},${type}) $index] \
	        background $tabOption(${tab},Background)

	    # Now do the user-defined un-selection callbacks.
	    if { [llength $tabUnSelectionCB(${tab},${type})] > 0} {
	        foreach cb $tabUnSelectionCB(${tab},${type}) { 
		    $cb $tab $row $col $x $y 0
		}
	    }

	} else {
            tableSet${type}Attr ${tab} \
	        $row $col background $tabOption(${tab},Background)

	    # Now do the user-defined selection callbacks.
	    if { [llength $tabUnSelectionCB(${tab},${type})] > 0} {
	        foreach cb $tabUnSelectionCB(${tab},${type}) { 
		    $cb $tab $row $col $x $y 0
		}
	    }
	}

	# Delete it from the list
	set tabSelected(${tab},${type}) \
	    [ lreplace $tabSelected(${tab},${type}) $index $index ]

	# Go back and re-select the row/col intersection but don't 
	# generate an event for it, purely cosmetic.
	if {$type == "Row"} {
	    foreach c $tabSelected(${tab},Col) {
                tableSetColAttr ${tab} $c background $color
	    }
	} elseif {$type == "Col"} {
	    foreach c $tabSelected(${tab},Row) {
                tableSetRowAttr ${tab} $c background $color
	    }
	}

    } else {

        # Highlight the selected item.
	if {$type != "Cell"} {
            tableSet${type}Attr ${tab} $val background $color
            tableSet${type}Attr ${tab}${type} $val background $color
	} else {
            tableSet${type}Attr ${tab} $row $col background $color
	}

        # Now do the user-defined selection callbacks.
        if { [llength $tabSelectionCB(${tab},${type})] > 0} {
            foreach cb $tabSelectionCB(${tab},${type}) { 
	        $cb $tab $row $col $x $y 1
	    }
        }
    }
}


# TABLESETDEFAULTLABELS -- Set the default labels for the table, i.e. letters
# for columns headings and numbers for the row labels.
#
#  Usage:	
#	    tableSetDefaultLabels  <tab>

proc tableSetDefaultLabels { tab } {
    # Set the default Row labels, i.e numbers
    tableSetDefaultRowLabels $tab

    # Now set the default Column Labels, i.e. letters
    tableSetDefaultColLabels $tab
}
    

# TABLESETDEFAULTTRANSLATIONS -- Set the default translations for the widget.

proc tableSetDefaultTranslations { tab } {

    if {[ tableOption $tab DefaultTranslations ] == "no"} {
	return
    }

    # Set the coord tracking translations.
    set trans1 ""
    if {[ tableOption $tab Tracking ] == "yes"} {
	set trans1 { \
	    <Motion>:call(tableTrack,$name,$x,$y)
	}
    }
		
    set trans2 ""
    if {[ tableOption $tab CellSelect ] == "yes"} {
	set trans2 { \
	    <Btn1Down>:call(tableSelect,$name,Cell,$x,$y)
	}
    }
		
    set trans3 ""
    if {[ tableOption $tab Editable ] == "yes"} {
	set trans3 { \
	    <Btn3Down>:call(tableEdit,$name,$x,$y)
	}
    }
    set trans "$trans1 $trans2 $trans3"
    send ${tab}Tab set translations $trans


    # Set the row-selectable translations.
    if {[ tableOption $tab RowSelect ] == "yes"} {
        send ${tab}RowTab set translations \
	    "<Btn1Down>: call(tableSelect,\$name,Row,\$x,\$y)"
    }

    # Set the col-selectable translations.
    if {[ tableOption $tab ColSelect ] == "yes"} {
        send ${tab}ColTab set translations \
	    "<Btn1Down>: call(tableSelect,\$name,Col,\$x,\$y)"
    }
}


# TABLESETDEFAULTSCROLLBARS -- Set the default scrollbar position and size
# in the meta-widget.

proc tableSetDefaultScrollbars { tab init } {
    global tabHeight tabWidth tabScrollSize tabScrollPos tabDebug
    global tabNcols tabNrows tabColWidths


    set visW [ send ${tab}TabView get width]
    set visH [ send ${tab}TabView get height]
    set rh   [ send ${tab}Tab get rowHeight]
    set sw   [ send ${tab}Tab get shadowWidth]
    set th   [expr ($tabNrows(${tab},data) * ($rh + (2 * $sw)) )]
    set tw    0
    for {set i 1} {$i <= $tabNcols(${tab},data)} {incr i} {
	set  w $tabColWidths(${tab},$i)
	set tw [ expr ($tw + $w + (2 * $sw)) ]
    }
    set rowS [max 0.0 [min 1.0 [expr (double($visH)/double($th)) ]]]
    set colS [max 0.0 [min 1.0 [expr (double($visW)/double($tw)) ]]]
#print "defScroll: data visW=$visW  visH=$visH  th=$th  tw=$tw"
#print "defScroll: ($tab,$init)  rowS = $rowS   colS = $colS"
			
    set tabScrollSize($tab,row) $rowS
    set tabScrollSize($tab,col) $colS
    set tabScrollPos($tab,row)  0.0
    set tabScrollPos($tab,col)  0.0

    if {[ tableOption $tab RowScroll] == "yes"} {
        send ${tab}RowScroll setScrollbar 0.0 $tabScrollSize($tab,row)
    }
    if {[ tableOption $tab ColScroll] == "yes"} {
        send ${tab}ColScroll setScrollbar 0.0 $tabScrollSize($tab,col)
    }

    if {$init == "yes"} {
	send ${tab}TabView    setLocation 0.0 0.0
	send ${tab}ColTabView setLocation 0.0 0.0
	send ${tab}RowTabView setLocation 0.0 0.0
    }
}


# TABLEJUMPSCROLL -- Scroll the specified table.  This scrolls both the
# data and row/column label tables.

proc tableJumpScroll { widget cbtype pos } {
    global scrollHeight tabWidth tabHeight tabDebug
    global tabScrollSize tabScrollPos tabDebug

    if {$pos < 0.01} { 
	set pos 0.0 
    }

    if { [string match *ColScroll $widget] } {
	regsub ColScroll $widget "" tab
	set y $tabScrollPos($tab,row)
        send ${tab}TabView    setLocation $pos $y
        send ${tab}ColTabView setLocation $pos 0.0
	set tabScrollPos($tab,col) $pos

    } elseif { [string match *RowScroll $widget] } {
	regsub RowScroll $widget "" tab
	set x $tabScrollPos($tab,col)
        send ${tab}TabView    setLocation $x  $pos
        send ${tab}RowTabView setLocation 0.0 $pos
	set tabScrollPos($tab,row) $pos
    }
}


# TABLEOPTION -- Return any defined table option.

proc tableOption { tab option } {
    global tabOption

    set val yes
    catch { 
	if {[info exists tabOption(${tab},${option}) ]} { 
	    if { $tabOption(${tab},${option}) } { 
		set val yes 
	    } else {
		set val no 
	    }
	} 
    } err 

    return $val
}


# TABLEPOS2CELLX -- Convert a widget position to a cell column number.

proc tablePos2CellX { tab x } {
    global tabColWidths tabNcols 

    set nc [ tableGetNcols $tab ]
    set cellX 1
    for {set w 0} {$w < $x && $cellX <= $nc} {incr cellX} {
	set w [ expr ($w + $tabColWidths($tab,$cellX) + 3) ]
    }
    if {$x > $w} {
	return -1
    } else {
        return [ min [incr cellX -1] $tabNcols(${tab},data) ]
    }
}

# TABLEPOS2CELLY -- Convert a widget position to a cell row number.

proc tablePos2CellY { tab y } {
    global tabRowHeights tabNrows 

    set nr [ tableGetNrows $tab ]
    set cellY 1
    for {set h 0} {$h < $y && $cellY <= $nr} {incr cellY} {
	set h [ expr ($h + $tabRowHeights($tab,$cellY)) + 2 ]
    }
    if {$y > $h} {
	return -1
    } else {
        return [ min [incr cellY -1] $tabNrows(${tab},data) ]
    }
}


# TABLESETDEFAULTROWLABELS  -- Utility to set the default row labels.

proc tableSetDefaultRowLabels { tab args } {
    global tabNrows tabOption

    # Set the default Row labels, i.e numbers
    set rowlabs {}
    for {set i 1} {$i <= $tabNrows(${tab},data)} {incr i} {
	if {[ tableOption $tab DefLabels ] == "yes"} {
	    lappend rowlabs $i
        } else {
	    lappend rowlabs {}
        }
    }
    if {[ tableOption $tab RowLabels ] == "yes"} {
    	send ${tab}RowTab setTable $tabNrows(${tab},data) \
            $tabOption(${tab},RowLabelCols) $rowlabs
	set cw [send ${tab}RowTab get defaultWidth]
	send ${tab}RowTabView set width \
	    [expr ($tabOption(${tab},RowLabelCols) * $cw)]
    } else {
    	send ${tab}RowTab set width 0
    }
}


# TABLESETDEFAULTCOLLABELS -- Utility to set the default columns labels.

proc tableSetDefaultColLabels { tab args } {
    global tabNcols tabOption

    # Now set the default Column Labels, i.e. letters
    set collabs ""
    set j 65
    for {set i 1} {$i <= $tabNcols(${tab},data)} {incr i} {
	if {[ tableOption $tab DefLabels ] == "yes"} {
	    if {$j > 90} {
		set j 97
		set collabs [ format "%s { %c } " $collabs $j ]
	    } elseif {$j > 122} {
		set j 1
		set collabs [ format "%s { %d } " $collabs $j ]
	    } else {
		set collabs [ format "%s { %c } " $collabs $j ]
	    }
	    incr j
        } else {
	    lappend collabs {}
        }
    }
    if {[ tableOption $tab ColLabels ] == "yes"} {
        send ${tab}ColTab setTable $tabOption(${tab},ColLabelRows) \
	    $tabNcols(${tab},data) [ list $collabs ]
	send ${tab}ColTabView set height \
	    [expr ($tabOption(${tab},ColLabelRows) * 21)]
	send ${tab}Spacer1 set height \
	    [expr ($tabOption(${tab},ColLabelRows) * 24)]
	send ${tab}Spacer2 set height \
	    [expr ($tabOption(${tab},ColLabelRows) * 24)]
    } else {
        send ${tab}ColTab set height 0
    }
}


################################################################################


################################################################################



activate


appExtend {
    *tclObjects:\
	toplevel	TopLevelShell   tcl_panel\
	tcl_panel  	Layout		tclLayout\
	tclLayout  	Group		tclCmdGroup\
	tclCmdGroup  	Layout	 	tclCmd\
	tclCmd	 	Command	 	tclClear\
	tclCmd	 	Command	 	tclExecute\
	tclCmd	 	Command	 	tclDismiss\
	tclLayout  	Frame	 	tclFrame\
	tclFrame	AsciiText  	tclEntry


    !--------------------------------
    ! Define a debug Tcl shell.
    !--------------------------------
    *tcl_panel.width:                           550
    *tcl_panel.height:                          180
    *tcl_panel.title:                           Debug TCL Command Entry
    *tclLayout*borderWidth:                     0
    *tclLayout*shrinkToFit:			True
    *tclLayout*Frame.frameType:                 sunken
    *tclLayout*Frame.frameWidth:                2
    *tclLayout.layout:  vertical { \
        tclCmdGroup < +inf -inf * > \
        tclFrame < +inf -inf * +inf -inf> \
    }
    *tclEntry*foreground:                       black
    *tclEntry*editType:                         edit
    *tclEntry*type:                             string
    *tclEntry*font:				7x13
    *tclEntry*scrollVertical:                   Always
    *tclEntry*scrollHorizontal:                 whenNeeded

    *tclCmdGroup.label:         
    *tclCmdGroup.outerOffset:                   0
    *tclCmdGroup.innerOffset:                   0
    *tclCmd.layout: vertical { \
        5 \
        horizontal { 5 tclClear 3 tclExecute 10 < +inf -10> tclDismiss 5 } \
        5 \
    }
    *tclClear.label:                            Clear
    *tclExecute.label:                          Execute
    *tclDismiss.label:                          Dismiss

} ; createObjects tclObjects



################################################
# Define some TCL debug procedures.
################################################

proc tclCommandClear {widget args} {
    send tclEntry set string ""
} ; send tclClear addCallback tclCommandClear

proc tclCommandExecute {widget args} {
    send server [send tclEntry {get string}]
} ; send tclExecute addCallback tclCommandExecute

proc tclCommand {widget mode command args} {
    send server $command
} ; send tclEntry   addCallback tclCommand

proc tclClose {widget args} {
    send tcl_panel unmap
} ; send tclDismiss addCallback tclClose

send tclShell addCallback "send tcl_panel map"