.tag_configure tagName [option] | [option=value]+"
+
+ def tag_delete(self, tagName):
+ self.tk.call(self._w, 'tag', 'delete', tagName)
+
+ def tag_exists(self, tagName):
+ return self.getboolean(self.tk.call(self._w, 'tag', 'exists', tagName))
+
+ def tag_includes(self, tagName, index):
+ return self.getboolean(self.tk.call(self._w, 'tag', 'includes', tagName, index))
+
+ def tag_names(self, pattern=None):
+ return self.tk.call(self._w, 'tag', 'names', pattern)
+
+ def tag_row(self, tagName, *args):
+ result = apply(self.tk.call, (self._w, 'tag', 'row', tagName) + args)
+ if not args: return self._getLines(result)
+
+ def validate(self, index):
+ self.tk.call(self._w, 'validate', index)
+
+ def width(self, *args):
+ result = apply(self.tk.call, (self._w, 'width') + args)
+ if not args:
+ str = string.replace(result, '{', '')
+ str = string.replace(str, '}', '')
+ lst = string.split(str)
+ x = len(lst)
+ x2 = x / 2
+ return tuple(map(lambda i, j, l=lst: (int(l[i]), int(l[j])),
+ xrange(x2), xrange(x2, x)))
+ elif len(args) == 1:
+ return int(result)
+ else:
+ return result
+
+ def xview(self, *args):
+ if not args:
+ return self._getdoubles(self.tk.call(self._w, 'xview'))
+ apply(self.tk.call, (self._w, 'xview') + args)
+
+ def yview(self, *args):
+ if not args:
+ return self._getdoubles(self.tk.call(self._w, 'yview'))
+ apply(self.tk.call, (self._w, 'yview') + args)
+#----------------------------------------------------------------------------
+
+
+#============================================================================
+# Test-Function
+#----------------------------------------------------------------------------
+if __name__ == '__main__':
+ from Tkinter import Tk, Label, Button
+ import pprint
+
+ prn = pprint.PrettyPrinter(indent = 6).pprint
+
+ def test_cmd(event=None):
+ if event.i == 0:
+ return '%i, %i' % (event.r, event.c)
+ else:
+ return 'set'
+
+
+ def browsecmd(event):
+ print "event:", event.__dict__
+ print "curselection:", test.curselection()
+ print "active:", test.index('active', 'row')
+ print "anchor:", test.index('anchor', 'row')
+
+ root = Tk()
+ #root.tk.call('load', '', 'Tktable')
+
+ var = ArrayVar(root)
+ for y in range(-1, 4):
+ for x in range(-1, 5):
+ index = "%i,%i" % (y, x)
+ var.set(index, index)
+
+ label = Label(root, text="Proof-of-existence test for Tktable")
+ label.pack(side = 'top', fill = 'x')
+
+ quit = Button(root, text="QUIT", command=root.destroy)
+ quit.pack(side = 'bottom', fill = 'x')
+
+ test = Table(root,
+ rows=10,
+ cols=5,
+ state='disabled',
+ width=6,
+ height=6,
+ titlerows=1,
+ titlecols=1,
+ roworigin=-1,
+ colorigin=-1,
+ selectmode='browse',
+ selecttype='row',
+ rowstretch='unset',
+ colstretch='last',
+ browsecmd=browsecmd,
+ flashmode='on',
+ variable=var,
+ usecommand=0,
+ command=test_cmd)
+ test.pack(expand=1, fill='both')
+ test.tag_configure('sel', background = 'yellow')
+ test.tag_configure('active', background = 'blue')
+ test.tag_configure('title', anchor='w', bg='red', relief='sunken')
+ root.mainloop()
+#----------------------------------------------------------------------------
diff --git a/tktable/demos/valid.tcl b/tktable/demos/valid.tcl
new file mode 100644
index 0000000..8a16a11
--- /dev/null
+++ b/tktable/demos/valid.tcl
@@ -0,0 +1,95 @@
+#!/bin/sh
+# the next line restarts using wish \
+exec wish "$0" ${1+"$@"}
+
+## valid.tcl
+##
+## This demos shows the use of the validation mechanism of the table
+## and uses the table's cache (no -command or -variable)
+##
+## jeff at hobbs org
+
+source [file join [file dirname [info script]] loadtable.tcl]
+
+array set table {
+ rows 10
+ cols 10
+ table .table
+}
+
+proc colorize num {
+ if {$num>0 && $num%2} { return colored }
+}
+
+proc fill_headers {w {r 10} {c 10}} {
+ for {set i 1} {$i < $r} {incr i} {
+ $w set $i,0 "$i"
+ }
+ for {set j 1} {$j < $c} {incr j} {
+ if {$j%3==1} {
+ $w set 0,$j AlphaNum
+ } elseif {$j%2==1} {
+ $w set 0,$j Alpha
+ } elseif {$j} {
+ $w set 0,$j Real
+ }
+ }
+}
+
+proc validate {c val} {
+ if {$c%3==1} {
+ ## Alphanum
+ set expr {^[A-Za-z0-9 ]*$}
+ } elseif {$c%2==1} {
+ ## Alpha
+ set expr {^[A-Za-z ]*$}
+ } elseif {$c} {
+ ## Real
+ set expr {^[-+]?[0-9]*\.?[0-9]*([0-9]\.?e[-+]?[0-9]*)?$}
+ }
+ if {[regexp $expr $val]} {
+ return 1
+ } else {
+ bell
+ return 0
+ }
+}
+
+label .example -text "TkTable v1 Validated Table Example"
+
+set t $table(table)
+table $t \
+ -rows $table(rows) \
+ -cols $table(cols) \
+ -cache 1 \
+ -titlerows 1 \
+ -titlecols 1 \
+ -yscrollcommand { .tsy set } \
+ -xscrollcommand { .tsx set } \
+ -width 5 -height 5 \
+ -coltagcommand colorize \
+ -flashmode on \
+ -selectmode extended \
+ -colstretch unset \
+ -rowstretch unset \
+ -validate yes \
+ -vcmd {if {![%W tag includes title %C]} { validate %c %S } }
+
+fill_headers $t
+$t tag config colored -bg lightblue
+$t tag config title -fg red
+$t width 0 3
+
+scrollbar .tsy -command [list $t yview]
+scrollbar .tsx -command [list $t xview] -orient horizontal
+button .exit -text "Exit" -command {exit}
+
+grid .example - -sticky ew
+grid $t .tsy -sticky news
+grid .tsx -sticky ew
+grid .exit - -sticky ew
+grid columnconfig . 0 -weight 1
+grid rowconfig . 1 -weight 1
+
+puts [list Table is $table(table)]
+
diff --git a/tktable/doc/tkTable.html b/tktable/doc/tkTable.html
new file mode 100644
index 0000000..4b264ff
--- /dev/null
+++ b/tktable/doc/tkTable.html
@@ -0,0 +1,2039 @@
+
+
+
+
+
+man page(1) manual page
+
+
+Table of Contents
+______________________________________________________________________________
+
+
+
+
+
+table - Create and manipulate tables
+
+
+
+
+
+table pathName ?options?
+
+
+
+
+
+
+
+- -anchor
+- -background -cursor
+
+
+- -exportselection
+- -font -foreground
+
+
+- -highlightbackground
+- -highlightcolor -highlightthickness
+
+
+- -insertbackground
+- -insertborderwidth-insertofftime
+-insertontime -insertwidth -invertselected
+
+
+- -relief
+- -takefocus -xscrollcommand
+-yscrollcommand
+
+
+
+
+See the options manual entry for details on the standard options.
+
+
+
+
+
+Command-Line Name:-autoclear
+
+Database Name: autoClear
+
+Database Class: AutoClear
+
+
+A boolean value which specifies whether the first keypress in a
+cell will delete whatever text was previously there. Defaults
+to 0.
+
+
+Command-Line Name:-bordercursor
+
+Database Name: borderCursor
+
+Database Class: Cursor
+
+
+Specifies the name of the cursor to show when over borders, a
+visual indication that interactive resizing is allowed (it is
+thus affect by the value of -resizeborders). Defaults to
+crosshair.
+
+
+Command-Line Name:-borderwidth or -bd
+
+Database Name: borderWidth
+
+Database Class: BorderWidth
+
+
+Specifies a non-negative pixel value or list of values indicating
+the width of the 3-D border to draw on interior table cells
+(if such a border is being drawn; the relief option typically
+determines this). If one value is specified, a rectangle of
+this width will be drawn. If two values are specified, then
+only the left and right edges of the cell will have borders. If
+four values are specified, then the values correspond to the
+{left right top bottom} edges. This can be overridden by the a
+tag's borderwidth option. It can also be affected by the
+defined -drawmode for the table. Each value in the list must
+have one of the forms acceptable to Tk_GetPixels.
+
+
+Command-Line Name:-browsecommand or -browsecmd
+Database Name: browseCommand
+
+Database Class: BrowseCommand
+
+
+Specifies a command which will be evaluated anytime the active
+cell changes. It uses the %-substition model described in COMMAND
+SUBSTITUTION below. Any changes to the active cell while
+the command is running are ignored to prevent recursion.
+
+
+Command-Line Name:-cache
+
+Database Name: cache
+
+Database Class: Cache
+
+
+A boolean value that specifies whether an internal cache of the
+table contents should be kept. This greatly enhances speed performance
+when used with -command but uses extra memory. Can
+maintain state when both -command and -variable are empty. The
+cache is automatically flushed whenever the value of -cache or
+-variable changes, otherwise you have to explicitly call clear
+on it. Defaults to off.
+
+
+Command-Line Name:-colorigin
+
+Database Name: colOrigin
+
+Database Class: Origin
+
+
+Specifies what column index to interpret as the leftmost column
+in the table. This value is used for user indices in the table.
+Defaults to 0.
+
+
+Command-Line Name:-cols
+
+Database Name: cols
+
+Database Class: Cols
+
+
+Number of cols in the table. Defaults to 10.
+
+
+Command-Line Name:-colseparator
+
+Database Name: colSeparator
+
+Database Class: Separator
+
+
+Specifies a separator character that will be interpreted as the
+column separator when cutting or pasting data in a table. By
+default, columns are separated as elements of a tcl list.
+
+
+Command-Line Name:-colstretchmode
+
+Database Name: colStretchMode
+
+Database Class: StretchMode
+
+
+Specifies one of the following stretch modes for columns to fill
+extra allocated window space:
+
+
+none Columns will not stretch to fill the assigned window
+space. If the columns are too narrow, there will be a
+blank space at the right of the table. This is the
+default.
+
+
+unset Only columns that do not have a specific width set will
+be stretched.
+
+
+
+
+- all
+- All columns will be stretched by the same number of pixels
+to fill the window space allocated to the table.
+This mode can interfere with interactive border resizing
+which tries to force column width.
+
+
+
+
+last The last column will be stretched to fill the window
+space allocated to the table.
+
+
+fill (only valid for -rowstretch currently)
+The table will get more or less columns according to the
+window space allocated to the table. This mode has
+numerous quirks and may disappear in the future.
+
+
+Command-Line Name:-coltagcommand
+
+Database Name: colTagCommand
+
+Database Class: TagCommand
+
+
+Provides the name of a procedure that will be evaluated by the
+widget to determine the tag to be used for a given column. When
+displaying a cell, the table widget will first check to see if a
+tag has been defined using the tag col widget method. If no tag
+is found, it will evaluate the named procedure passing the column
+number in question as the sole argument. The procedure is
+expected to return the name of a tag to use, or a null string.
+Errors occurring during the evaluation of the procedure, or the
+return of an invalid tag name are silently ignored.
+
+
+Command-Line Name:-colwidth
+
+Database Name: colWidth
+
+Database Class: ColWidth
+
+
+Default column width, interpreted as characters in the default
+font when the number is positive, or pixels if it is negative.
+Defaults to 10.
+
+
+Command-Line Name:-command
+
+Database Name: command
+
+Database Class: Command
+
+
+Specified a command to use as a procedural interface to cell
+values. If -usecommand is true, this command will be used
+instead of any reference to the -variable array. When retrieving
+cell values, the return value of the command is used as the
+value for the cell. It uses the %-substition model described in
+COMMAND SUBSTITUTION below.
+
+
+Command-Line Name:-drawmode
+
+Database Name: drawMode
+
+Database Class: DrawMode
+
+
+Sets the table drawing mode to one of the following options:
+
+
+slow The table is drawn to an offscreen pixmap using the Tk
+bordering functions (double-buffering). This means there
+will be no flashing, but this mode is slow for larger
+tables.
+
+
+compatible
+
+The table is drawn directly to the screen using the Tk
+border functions. It is faster, but the screen may flash
+on update. This is the default.
+
+
+
+
+- fast
+- The table is drawn directly to the screen and the borders
+are done with fast X calls, so they are always one pixel
+wide only. As a side effect, it restricts -borderwidth
+to a range of 0 or 1. This mode provides best performance
+for large tables, but can flash on redraw and is
+not 100% Tk compatible on the border mode.
+
+
+
+
+single The table is drawn to the screen as in fast mode, but
+only single pixel lines are drawn (not square borders).
+
+
+Command-Line Name:-ellipsis
+
+Database Name: ellipsis
+
+Database Class: Ellipsis
+
+
+This specifies a string to display at the end of a line that
+would be clipped by its cell, like ``...''. An ellipsis will be
+displayed only on non-wrapping, non-multiline cells that would
+be clipped. The ellipsis will display on the left for east
+anchored cells, otherwise it displays on the right. Defaults to
+ (no ellipsis).
+
+
+Command-Line Name:-flashmode
+
+Database Name: flashMode
+
+Database Class: FlashMode
+
+
+A boolean value which specifies whether cells should flash when
+their value changes. The table tag flash will be applied to
+these cells for the duration specified by -flashtime. Defaults
+to 0.
+
+
+Command-Line Name:-flashtime
+
+Database Name: flashTime
+
+Database Class: FlashTime
+
+
+The amount of time, in 1/4 second increments, for which a cell
+should flash when its value has changed. -flashmode must be on.
+Defaults to 2.
+
+
+Command-Line Name:-height
+
+Database Name: height
+
+Database Class: Height
+
+
+Specifies the desired height for the window, in rows. If zero
+or less, then the desired height for the window is made just
+large enough to hold all the rows in the table. The height can
+be further limited by -maxheight.
+
+
+Command-Line Name:-invertselected
+
+Database Name: invertSelected
+
+Database Class: InvertSelected
+
+
+Specifies whether the foreground and background of an item
+should simply have their values swapped instead of merging the
+sel tag options when the cell is selected. Defaults to 0 (merge
+sel tag).
+
+
+Command-Line Name:-ipadx
+
+Database Name: ipadX
+
+Database Class: Pad
+
+
+A pixel value specifying the internal offset X padding for text
+in a cell. This value does not grow the size of the cell, it
+just causes the text to be drawn further from the cell border.
+It only affects one side (depending on anchor). Defaults to 0.
+See -padx for an alternate padding style.
+
+
+Command-Line Name:-ipady
+
+Database Name: ipadY
+
+Database Class: Pad
+
+
+A pixel value specifying the internal offset Y padding for text
+in a cell. This value does not grow the size of the cell, it
+just causes the text to be drawn further from the cell border.
+It only affects one side (depending on anchor). Defaults to 0.
+See -pady for an alternate padding style.
+
+
+Command-Line Name:-justify
+
+Database Name: justify
+
+Database Class: Justify
+
+
+How to justify multi-line text in a cell. It must be one of
+left, right, or center. Defaults to left.
+
+
+Command-Line Name:-maxheight
+
+Database Name: maxHeight
+
+Database Class: MaxHeight
+
+
+The max height in pixels that the window will request. Defaults
+to 600.
+
+
+Command-Line Name:-maxwidth
+
+Database Name: maxWidth
+
+Database Class: MaxWidth
+
+
+The max width in pixels that the window will request. Defaults
+to 800.
+
+
+Command-Line Name:-multiline
+
+Database Name: multiline
+
+Database Class: Multiline
+
+
+Specifies the default setting for the multiline tag option.
+Defaults to 1.
+
+
+Command-Line Name:-padx
+
+Database Name: padX
+
+Database Class: Pad
+
+
+A pixel value specifying the offset X padding for a cell. This
+value causes the default size of the cell to increase by two
+times the value (one for each side), unless a specific pixel
+size is chosen for the cell with the width command. This will
+force an empty area on the left and right of each cell edge.
+This padding affects all types of data in the cell. Defaults to
+0. See -ipadx for an alternate padding style.
+
+
+Command-Line Name:-pady
+
+Database Name: padY
+
+Database Class: Pad
+
+
+A pixel value specifying the offset Y padding for a cell. This
+value causes the default size of the cell to increase by two
+times the value (one for each side), unless a specific pixel
+size is chosen for the cell with the height command. This will
+force an empty area on the top and bottom of each cell edge.
+This padding affects all types of data in the cell. Defaults to
+0. See -ipadx for an alternate padding style.
+
+
+Command-Line Name:-resizeborders
+
+Database Name: resizeBorders
+
+Database Class: ResizeBorders
+
+
+Specifies what kind of interactive border resizing to allow,
+must be one of row, col, both (default) or none.
+
+
+Command-Line Name:-rowheight
+
+Database Name: rowHeight
+
+Database Class: RowHeight
+
+
+Default row height, interpreted as lines in the default font
+when the number is positive, or pixels if it is negative.
+Defaults to 1.
+
+
+Command-Line Name:-roworigin
+
+Database Name: rowOrigin
+
+Database Class: Origin
+
+
+Specifies what row index to interpret as the topmost row in the
+table. This value is used for user indices in the table.
+Defaults to 0.
+
+
+Command-Line Name:-rows
+
+Database Name: rows
+
+Database Class: Rows
+
+
+Number of rows in the table. Defaults to 10.
+
+
+Command-Line Name:-rowseparator
+
+Database Name: rowSeparator
+
+Database Class: Separator
+
+
+Specifies a separator character that will be interpreted as the
+row separator when cutting or pasting data in a table. By
+default, rows are separated as tcl lists.
+
+
+Command-Line Name:-rowstretchmode
+
+Database Name: rowStretchMode
+
+Database Class: StretchMode
+
+
+Specifies the stretch modes for rows to fill extra allocated
+window space. See -colstretchmode for valid options.
+
+
+Command-Line Name:-rowtagcommand
+
+Database Name: rowTagCommand
+
+Database Class: TagCommand
+
+
+Provides the name of a procedure that can evaluated by the widget
+to determine the tag to be used for a given row. The procedure
+must be defined by the user to accept a single argument
+(the row number), and return a tag name or null string. This
+operates in a similar manner as -coltagcommand, except that it
+applies to row tags.
+
+
+Command-Line Name:-selectioncommand or -selcmd
+Database Name: selectionCommand
+
+Database Class: SelectionCommand
+
+
+Specifies a command to evaluate when the selection is retrieved
+from a table via the selection mechanism (ie: evaluating
+``selection get''). The return value from this command will
+become the string passed on by the selection mechanism. It uses
+the %-substition model described in COMMAND SUBSTITUTION below.
+If an error occurs, a Tcl background error is generated and
+nothing is returned.
+
+
+Command-Line Name:-selectmode
+
+Database Name: selectMode
+
+Database Class: SelectMode
+
+
+Specifies one of several styles for manipulating the selection.
+The value of the option may be arbitrary, but the default bindings
+expect it to be either single, browse, multiple, or
+extended; the default value is browse. These styles are like
+those for the Tk listbox, except expanded for 2 dimensions.
+
+
+Command-Line Name:-selecttitle
+
+Database Name: selectTitles
+
+Database Class: SelectTitles
+
+
+Specifies whether title cells should be allowed in the selection.
+Defaults to 0 (disallowed).
+
+
+Command-Line Name:-selecttype
+
+Database Name: selectType
+
+Database Class: SelectType
+
+
+Specifies one of several types of selection for the table. The
+value of the option may be one of row, col, cell, or both
+(meaning row && col); the default value is cell. These types
+define whether an entire row/col is affected when a cell's
+selection is changed (set or clear).
+
+
+Command-Line Name:-sparsearray
+
+Database Name: sparseArray
+
+Database Class: SparseArray
+
+
+A boolean value that specifies whether an associated Tcl array
+should be kept as a sparse array (1, the default) or as a full
+array (0). If true, then cell values that are empty will be
+deleted from the array (taking less memory). If false, then all
+values in the array will be maintained.
+
+
+Command-Line Name:-state
+
+Database Name: state
+
+Database Class: State
+
+
+Specifies one of two states for the entry: normal or disabled.
+If the table is disabled then the value may not be changed using
+widget commands and no insertion cursor will be displayed, even
+if the input focus is in the widget. Also, all insert or delete
+methods will be ignored. Defaults to normal.
+
+
+Command-Line Name:-titlecols
+
+Database Name: titleCols
+
+Database Class: TitleCols
+
+
+Number of columns to use as a title area. Defaults to 0.
+
+
+Command-Line Name:-titlerows
+
+Database Name: titleRows
+
+Database Class: TitleRows
+
+
+Number of rows to use as a title area. Defaults to 0.
+
+
+Command-Line Name:-usecommand
+
+Database Name: useCommand
+
+Database Class: UseCommand
+
+
+A boolean value which specifies whether to use the command
+option. This value sets itself to zero if command is used and
+returns an error. Defaults to 1 (will use command if specified).
+
+
+Command-Line Name:-validate
+
+Database Name: validate
+
+Database Class: Validate
+
+
+A boolean specifying whether validation should occur for the
+active buffer. Defaults to 0.
+
+
+Command-Line Name:-validatecommand or -vcmd
+Database Name: validateCommand
+
+Database Class: ValidateCommand
+
+
+Specifies a command to execute when the active cell is edited.
+This command is expected to return a Tcl boolean. If it returns
+true, then it is assumed the new value is OK, otherwise the new
+value is rejected (the edition will not take place). Errors in
+this command are handled in the background. It uses the %-substition
+model described in COMMAND SUBSTITUTION below.
+
+
+Command-Line Name:-variable
+
+Database Name: variable
+
+Database Class: Variable
+
+
+Global Tcl array variable to attach to the table's C array. It
+will be created if it doesn't already exist or is a simple variable.
+Keys used by the table in the array are of the form
+row,col for cells and the special key active which contains the
+value of the active cell buffer. The Tcl array is managed as a
+sparse array (the table does not require that all valid indices
+have values). No stored value for an index is equivalent to the
+empty string, and clearing a cell will remove that index from
+the Tcl array, unless the -sparsearray options is set to 0.
+
+
+Command-Line Name:-width
+
+Database Name: width
+
+Database Class: Width
+
+
+Specifies the desired width for the window, in columns. If zero
+or less, then the desired width for the window is made just
+large enough to hold all the columns in the table. The width
+can be further limited by -maxwidth.
+
+
+Command-Line Name:-wrap
+
+Database Name: wrap
+
+Database Class: Wrap
+
+
+Specifies the default wrap value for tags. Defaults to 0.
+_________________________________________________________________
+
+
+
+
+
+The table command creates a 2-dimensional grid of cells. The table can
+use a Tcl array variable or Tcl command for data storage and retrieval,
+as well as optionally cache data in memory for speed. One of these
+data sources must be configured before any data is retained by the table.
+The widget has an active cell, the contents of which can be
+edited (when the state is normal). The widget supports a default style
+for the cells and also multiple tags, which can be used to change the
+style of a row, column or cell (see TAGS for details). A cell flash
+can be set up so that changed cells will change color for a specified
+amount of time ("blink"). Cells can have embedded images or windows,
+as described in TAGS and EMBEDDED WINDOWS respectively.
+
+
+One or more cells may be selected as described below. If a table is
+exporting its selection (see -exportselection option), then it will
+observe the standard X11 protocols for handling the selection. See THE
+SELECTION for details.
+
+
+It is not necessary for all the cells to be displayed in the table window
+at once; commands described below may be used to change the view in
+the window. Tables allow scrolling in both directions using the standard
+-xscrollcommand and -yscrollcommand options. They also support
+scanning, as described below.
+
+
+In order to obtain good performance, the table widget supports multiple
+drawing modes, two of which are fully Tk compatible.
+
+
+
+
+
+When the table command is loaded into an interpreter, a built-in Tcl
+command, tkTableInit, is evaluated. This will search for the appropriate
+table binding init file to load. The directories searched are
+those in $tcl_pkgPath, both with Tktable(version) appended and without,
+$tk_library and [pwd] (the current directory). You can also define an
+$env(TK_TABLE_LIBRARY) to head this search list. By default, the file
+searched for is called tkTable.tcl, but this can be overridden by setting
+$env(TK_TABLE_LIBRARY_FILE).
+
+
+This entire init script can be overridden by providing your own
+tkTableInit procedure before the library is loaded. Otherwise, the
+aforementioned env(TK_TABLE_LIBRARY) variable will be set with the
+directory in which $env(TK_TABLE_LIBRARY_FILE) was found.
+
+
+
+
+
+Many of the widget commands for tables take one or more indices as
+arguments. An index specifies a particular cell of the table, in any
+of the following ways:
+
+
+number,number
+
+Specifies the cell as a numerical index of row,col which
+corresponds to the index of the associated Tcl array, where
+-roworigin,-colorigin corresponds to the first cell in the
+table (0,0 by default). The values for row and column will
+be constrained to actual values in the table, which means a
+valid cell is always found.
+
+
+
+
+- active
+- Indicates the cell that has the location cursor. It is
+specified with the activate widget command.
+
+
+
+- anchor
+- Indicates the anchor point for the selection, which is set
+with the selection anchor widget command.
+
+
+
+
+bottomright Indicates the bottom-rightmost cell visible in the table.
+
+
+
+
+- end
+- Indicates the bottom right cell of the table.
+
+
+
+- origin
+- Indicates the top-leftmost editable cell of the table, not
+necessarily in the display. This takes into account the
+user specified origin and title area.
+
+
+
+- topleft
+- Indicates the top-leftmost editable cell visible in the table
+(this excludes title cells).
+
+
+
+- @x,y
+- Indicates the cell that covers the point in the table window
+specified by x and y (in pixel coordinates). If no
+cell covers that point, then the closest cell to that point
+is used.
+
+
+
+
+In the widget command descriptions below, arguments named index, first,
+and last always contain text indices in one of the above forms.
+
+
+
+
+
+A tag is a textual string that is associated with zero or more rows,
+columns or cells in a table. Tags may contain arbitrary characters,
+but it is probably best to avoid using names which look like indices to
+reduce coding confusion. A tag can apply to an entire row or column,
+or just a single cell. There are several permanent tags in each table
+that can be configured by the user and will determine the attributes
+for special cells:
+
+
+
+
+- active
+- This tag is given to the active cell
+
+
+
+- flash
+- If flash mode is on, this tag is given to any recently
+edited cells.
+
+
+
+- sel
+- This tag is given to any selected cells.
+
+
+
+- title
+- This tag is given to any cells in the title rows and
+columns. This tag has -state disabled by default.
+
+
+
+
+Tags control the way cells are displayed on the screen. Where appropriate,
+the default for displaying cells is determined by the options
+for the table widget. However, display options may be associated with
+individual tags using the ``pathName tag configure'' widget command.
+If a cell, row or column has been tagged, then the display options
+associated with the tag override the default display style. The following
+options are currently supported for tags:
+
+
+
+
+- -anchor anchor
+-
+Anchor for item in the cell space.
+
+
+
+- -background or -bg color
+-
+Background color of the cell.
+
+
+
+- -borderwidth or -bd pixelList
+-
+Borderwidth of the cell, of the same format for the table,
+but may also be empty to inherit the default table
+borderwidth value (the default).
+
+
+
+- -ellipsis string
+-
+String to display at the end of a line that would be
+clipped by its cell, like ``...''. An ellipsis will be
+displayed only on non-wrapping, non-multiline cells that
+would be clipped. The ellipsis will display on the left
+for east anchored cells, otherwise it displays on the
+right.
+
+
+
+- -font fontName
+-
+Font for text in the cell.
+
+
+
+- -foreground or -fg color
+-
+Foreground color of the cell.
+
+
+
+- -justify justify
+-
+How to justify multi-line text in a cell. It must be one
+of left, right, or center.
+
+
+
+- -image imageName
+-
+An image to display in the cell instead of text.
+
+
+
+- -multiline boolean
+-
+Whether to display text with newlines on multiple lines.
+
+
+
+- -relief relief
+-
+The relief for the cell. May be the empty string to
+cause this tag to not disturb the value.
+
+
+
+- -showtext boolean
+-
+Whether to show the text over an image.
+
+
+
+- -state state
+-
+The state of the cell, to allow for certain cells to be
+disabled. This prevents the cell from being edited by
+the insert or delete methods, but a direct set will not
+be prevented.
+
+
+
+- -wrap boolean
+-
+Whether characters should wrap in a cell that is not wide
+enough.
+
+
+
+
+A priority order is defined among tags based on creation order (first
+created tag has highest default priority), and this order is used in
+implementing some of the tag-related functions described below. When a
+cell is displayed, its properties are determined by the tags which are
+assigned to it. The priority of a tag can be modified by the ``path_Name
+tag lower'' and ``pathName tag raise'' widget commands.
+
+
+If a cell has several tags associated with it that define the same
+display options (eg - a title cell with specific row and cell tags),
+then the options of the highest priority tag are used. If a particular
+display option hasn't been specified for a particular tag, or if it is
+specified as an empty string, then that option will not be used; the
+next-highest-priority tag's option will be used instead. If no tag
+specifies a particular display option, then the default style for the
+widget will be used.
+
+
+Images are used for display purposes only. Editing in that cell will
+still be enabled and any querying of the cell will show the text value
+of the cell, regardless of the value of -showtext.
+
+
+
+
+
+There may be any number of embedded windows in a table widget (one per
+cell), and any widget may be used as an embedded window (subject to the
+usual rules for geometry management, which require the table window to
+be the parent of the embedded window or a descendant of its parent).
+The embedded window's position on the screen will be updated as the table
+is modified or scrolled, and it will be mapped and unmapped as it
+moves into and out of the visible area of the table widget. Each
+embedded window occupies one cell's worth of space in the table widget,
+and it is referred to by the index of the cell in the table. Windows
+associated with the table widget are destroyed when the table widget is
+destroyed.
+
+
+Windows are used for display purposes only. A value still exists for
+that cell, but will not be shown unless the window is deleted in some
+way. If the window is destroyed or lost by the table widget to another
+geometry manager, then any data associated with it is lost (the cell it
+occupied will no longer appear in window names).
+
+
+When an embedded window is added to a table widget with the window configure
+widget command, several configuration options may be associated
+with it. These options may be modified with later calls to the window
+configure widget command. The following options are currently supported:
+
+
+
+
+- -create script
+-
+NOT CURRENTLY SUPPORTED. Specifies a Tcl script that may
+be evaluated to create the window for the annotation. If
+no -window option has been specified for this cell then
+this script will be evaluated when the cell is about to
+be displayed on the screen. Script must create a window
+for the cell and return the name of that window as its
+result. If the cell's window should ever be deleted, the
+script will be evaluated again the next time the cell is
+displayed.
+
+
+
+- -background or -bg color
+-
+Background color of the cell. If not specified, it uses
+the table's default background.
+
+
+
+- -borderwidth or -bd pixelList
+-
+Borderwidth of the cell, of the same format for the table,
+but may also be empty to inherit the default table
+borderwidth value (the default).
+
+
+
+- -padx pixels
+-
+As defined in the Tk options man page.
+
+
+
+- -pady pixels
+-
+As defined in the Tk options man page.
+
+
+
+- -relief relief
+-
+The relief to use for the cell in which the window lies.
+If not specified, it uses the table's default relief.
+
+
+
+- -sticky sticky
+-
+Stickiness of the window inside the cell, as defined by
+the grid command.
+
+
+
+- -window pathName
+-
+Specifies the name of a window (widget) to display in the
+annotation. It must exist before being specified here.
+When an empty string is specified, if a window was displayed
+it will cease to be managed by the table widget.
+
+
+
+
+
+
+
+Table selections are available as type STRING. By default, the value
+of the selection will be the values of the selected cells in nested Tcl
+list form where each row is a list and each column is an element of a
+row list. You can change the way this value is interpreted by setting
+the -rowseparator and -colseparator options. For example, default
+Excel format would be to set -rowseparator to `\n' and -colseparator to
+`\t'. Changing these values affects both how the table sends out the
+selection and reads in pasted data, ensuring that the table should
+always be able to cut and paste to itself. It is possible to change
+how pastes are handled by editing the table library procedure
+tk_tablePasteHandler. This might be necessary if -selectioncommand is
+set.
+
+
+
+
+
+Individual cells can span multiple rows and/or columns. This is done
+via the spans command (see below for exact arguments). Cells in the
+title area that span are not permitted to span beyond the title area,
+and will be constrained accordingly. If the title area shrinks during
+a configure, sanity checking will occur to ensure the above. You may
+set spans on regular cells that extend beyond the defined row/col area.
+These spans will not be constrained, so that when the defined row/col
+area expands, the span will expand with it.
+
+
+When setting a span, checks are made as to whether the span would overlap
+an already spanning or hidden cell. This is an error and it not
+allowed. Spans can affect the overall speed of table drawing, although
+not significantly. If spans are not used, then there is no performance
+loss.
+
+
+Cells hidden by spanning cells still have valid data. This will be
+seen during cut and paste operations that involve hidden cells, or
+through direct access by a command like get or set.
+
+
+The drawing properties of spanning cells apply to only the visual area
+of the cell. For example, if a cell is center justified over 5
+columns, then when viewing any portion of those columns, it will appear
+centered in the visible area. The non-visible column area will not be
+considered in the centering calculations.
+
+
+
+
+
+The various option based commands that the table supports all support
+the familiar Tk %-substitution model (see bind for more details). The
+following %-sequences are recognized and substituted by the table widget:
+
+
+%c For SelectionCommand, it is the maximum number of columns in any
+row in the selection. Otherwise it is the column of the triggered
+cell.
+
+
+
+
+- %C
+- A convenience substitution for %r,%c.
+
+
+
+
+%i For SelectionCommand, it is the total number of cells in the
+selection. For Command, it is 0 for a read (get) and 1 for a
+write (set). Otherwise it is the current cursor position in the
+cell.
+
+
+%r For SelectionCommand, it is the number of rows in the selection.
+Otherwise it is the row of the triggered cell.
+
+
+%s For ValidateCommand, it is the current value of the cell being
+validated. For SelectionCommand, it is the default value of the
+selection. For BrowseCommand, it is the index of the last active
+cell. For Command, it is empty for reads (get) and the current
+value of the cell for writes (set).
+
+
+%S For ValidateCommand, it is the potential new value of the cell
+being validated. For BrowseCommand, it is the index of the new
+active cell.
+
+
+
+
+- %W
+- The pathname to the window for which the command was generated.
+
+
+
+
+
+
+
+The table command creates a new Tcl command whose name is pathName.
+This command may be used to invoke various operations on the widget.
+It has the following general form:
+
+pathName option ?arg arg ...?
+
+Option and the args determine the exact behavior of the command.
+
+
+The following commands are possible for table widgets:
+
+
+pathName activate index
+
+Sets the active cell to the one indicated by index.
+
+
+pathName bbox first ?last?
+
+It returns the bounding box for the specified cell (range) as a
+4-tuple of x, y, width and height in pixels. It clips the box
+to the visible portion, if any, otherwise an empty string is
+returned.
+
+
+pathName border option args
+
+This command is a voodoo hack to implement border sizing for
+tables. This is normally called through bindings, with the following
+as valid options:
+
+
+pathName border mark x y ?row|col?
+Records x and y and the row and/or column border under
+that point in the table window, if any; used in conjunction
+with later border dragto commands. Typically this
+command is associated with a mouse button press in the
+widget. If row or col is not specified, it returns a
+tuple of both border indices (an empty item means no border).
+Otherwise, just the specified item is returned.
+
+
+pathName border dragto x y
+
+This command computes the difference between its x and y
+arguments and the x and y arguments to the last border
+mark command for the widget. It then adjusts the previously
+marked border by the difference. This command is
+typically associated with mouse motion events in the widget,
+to produce the effect of interactive border resizing.
+
+
+pathName cget option
+
+Returns the current value of the configuration option given by
+option. Option may have any of the values accepted by the table
+command.
+
+
+pathName clear option ?first? ?last?
+
+This command is a convenience routine to clear certain state
+information managed by the table. first and last represent
+valid table indices. If neither are specified, then the command
+operates on the whole table. The following options are recognized:
+
+
+pathName clear cache ?first? ?last?
+Clears the specified section of the cache, if the table
+has been keeping one.
+
+
+pathName clear sizes ?first? ?last?
+Clears the specified row and column areas of specific
+height/width dimensions. When just one index is specified,
+for example 2,0, that is interpreted as row 2 and
+column 0.
+
+
+pathName clear tags ?first? ?last?
+Clears the specified area of tags (all row, column and
+cell tags).
+
+
+pathName clear all ?first? ?last?
+Performs all of the above clear functions on the specified
+area.
+
+
+pathName configure ?option? ?value option value ...?
+Query or modify the configuration options of the widget. If no
+option is specified, returns a list describing all of the available
+options for pathName (see Tk_ConfigureInfo for information
+on the format of this list). If option is specified with no
+value, then the command returns a list describing the one named
+option (this list will be identical to the corresponding sublist
+of the value returned if no option is specified). If one or
+more option-value pairs are specified, then the command modifies
+the given widget option(s) to have the given value(s); in this
+case the command returns an empty string. Option may have any
+of the values accepted by the table command.
+
+
+pathName curselection ?value?
+
+With no arguments, it returns the sorted indices of the currently
+selected cells. Otherwise it sets all the selected cells
+to the given value. The set has no effect if there is no associated
+Tcl array or the state is disabled.
+
+
+pathName curvalue ?value?
+
+If no value is given, the value of the cell being edited
+(indexed by active) is returned, else it is set to the given
+value.
+
+
+pathName delete option arg ?arg?
+
+This command is used to delete various things in a table. It
+has several forms, depending on the option:
+
+
+pathName delete active index ?index?
+Deletes text from the active cell. If only one index is
+given, it deletes the character after that index, otherwise
+it deletes from the first index to the second.
+index can be a number, insert or end.
+
+
+pathName delete cols ?switches? index ?count?
+Deletes count cols starting at (and including) col index.
+The index will be constrained to the limits of the
+tables. If count is negative, it deletes cols to the
+left. Otherwise it deletes cols to the right. count
+defaults to 1 (meaning just the column specified). At
+the moment, spans are not adjusted with this action.
+Optional switches are:
+
+
+
+
+- -holddimensions
+-
+Causes the table cols to be unaffected by the
+deletion (empty cols may appear). By default the
+dimensions are adjusted by count.
+
+
+
+- -holdselection
+-
+Causes the selection to be maintained on the
+absolute cells values. Otherwise, the selection
+will be cleared..
+
+
+
+- -holdtags
+-
+Causes the tags specified by the tag method to
+not move along with the data. Also prevents specific
+widths set by the width method from being
+adjusted. By default, these tags are properly
+adjusted.
+
+
+
+- -holdwindows
+-
+Causes the embedded windows created with the win_dow
+method to not move along with the data. By
+default, these windows are properly adjusted.
+
+
+
+- -keeptitles
+-
+Prevents title area cells from being changed.
+Otherwise they are treated just like regular
+cells and will move as specified.
+
+
+
+- --
+- Signifies the end of the switches.
+
+
+
+
+pathName delete rows ?switches? index ?count?
+Deletes count rows starting at (and including) row index.
+If count is negative, it deletes rows going up. Otherwise
+it deletes rows going down. The selection will be
+cleared. The switches are the same as those for column
+deletion.
+
+
+pathName get first ?last?
+
+Returns the value of the cells specified by the table indices
+first and (optionally) last in a list.
+
+
+pathName height ?row? ?value row value ...?
+If no row is specified, returns a list describing all rows for
+which a height has been set. If row is specified with no value,
+it prints out the height of that row in characters (positive
+number) or pixels (negative number). If one or more row-value
+pairs are specified, then it sets each row to be that height in
+lines (positive number) or pixels (negative number). If value
+is default, then the row uses the default height, specified by
+-rowheight.
+
+
+pathName hidden ?index? ?index ...?
+
+When called without args, it returns all the hidden cells (those
+cells covered by a spanning cell). If one index is specified,
+it returns the spanning cell covering that index, if any. If
+multiple indices are specified, it returns 1 if all indices are
+hidden cells, 0 otherwise.
+
+
+pathName icursor ?arg?
+
+With no arguments, prints out the location of the insertion cursor
+in the active cell. With one argument, sets the cursor to
+that point in the string. 0 is before the first character, you
+can also use insert or end for the current insertion point or
+the end of the text. If there is no active cell, or the cell or
+table is disabled, this will return -1.
+
+
+pathName index index ?row|col?
+
+Returns the integer cell coordinate that corresponds to index in
+the form row,col. If row or col is specified, then only the row
+or column index is returned.
+
+
+pathName insert option arg arg
+
+This command is used to into various things into a table. It
+has several forms, depending on the option:
+
+
+pathName insert active index value
+The value is a text string which is inserted at the index
+position of the active cell. The cursor is then positioned
+after the new text. index can be a number, insert
+or end.
+
+
+pathName insert cols ?switches? index ?count?
+Inserts count cols starting at col index. If count is
+negative, it inserts before the specified col. Otherwise
+it inserts after the specified col. The selection will
+be cleared. The switches are the same as those for column
+deletion.
+
+
+pathName insert rows ?switches? index ?count?
+Inserts count rows starting at row index. If count is
+negative, it inserts before the specified row. Otherwise
+it inserts after the specified row. The selection will
+be cleared. The switches are the same as those for column
+deletion.
+
+
+pathName reread
+
+Rereads the old contents of the cell back into the editing
+buffer. Useful for a key binding when <Escape> is pressed to
+abort the edit (a default binding).
+
+
+pathName scan option args
+
+This command is used to implement scanning on tables. It has
+two forms, depending on option:
+
+
+pathName scan mark x y
+
+Records x and y and the current view in the table window;
+used in conjunction with later scan dragto commands.
+Typically this command is associated with a mouse button
+press in the widget. It returns an empty string.
+
+
+pathName scan dragto x y.
+
+This command computes the difference between its x and y
+arguments and the x and y arguments to the last scan mark
+command for the widget. It then adjusts the view by 5
+times the difference in coordinates. This command is
+typically associated with mouse motion events in the widget,
+to produce the effect of dragging the list at high
+speed through the window. The return value is an empty
+string.
+
+
+pathName see index
+
+Adjust the view in the table so that the cell given by index is
+positioned as the cell one off from top left (excluding title
+rows and columns) if the cell is not currently visible on the
+screen. The actual cell may be different to keep the screen
+full.
+
+
+pathName selection option arg
+
+This command is used to adjust the selection within a table. It
+has several forms, depending on option:
+
+
+pathName selection anchor index
+
+Sets the selection anchor to the cell given by index.
+The selection anchor is the end of the selection that is
+fixed while dragging out a selection with the mouse. The
+index anchor may be used to refer to the anchor cell.
+
+
+pathName selection clear first ?last?
+If any of the cells between first and last (inclusive)
+are selected, they are deselected. The selection state
+is not changed for cells outside this range. first may
+be specified as all to remove the selection from all
+cells.
+
+
+pathName selection includes index
+Returns 1 if the cell indicated by index is currently
+selected, 0 if it isn't.
+
+
+pathName selection set first ?last?
+Selects all of the cells in the range between first and
+last, inclusive, without affecting the selection state of
+cells outside that range.
+
+
+pathName set ?row|col? index ?value? ?index value ...?
+Sets the specified index to the associated value. Table validation
+will not be triggered via this method. If row or col precedes
+the list of index/value pairs, then the value is assumed
+to be a Tcl list whose values will be split and set into the
+subsequent columns (if row is specified) or rows (for col). For
+example, set row 2,3 {2,3 2,4 2,5} will set 3 cells, from 2,3 to
+2,5. The setting of cells is silently bounded by the known table
+dimensions.
+
+
+pathName spans ?index? ?rows,cols index rows,cols ...?
+This command is used to manipulate row/col spans. When called
+with no arguments, all known spans are returned as a list of
+tuples of the form {index span}. When called with only the
+index, the span for that index only is returned, if any. Otherwise
+an even number of index rows,cols pairs are used to set
+spans. A span starts at the index and continues for the specified
+number of rows and cols. Negative spans are not supported.
+A span of 0,0 unsets any span on that cell. See EXAMPLES for
+more info.
+
+
+pathName tag option ?arg arg ...?
+
+This command is used to manipulate tags. The exact behavior of
+the command depends on the option argument that follows the tag
+argument. cget, cell, and row|col complain about unknown tag
+names. The following forms of the command are currently supported:
+
+
+pathName tag cell tagName ?index ...?
+With no arguments, prints out the list of cells that use
+the tag. Otherwise it sets the specified cells to use
+the named tag, replacing any tag that may have been set
+using this method before. If tagName is {}, the cells
+are reset to the default tag. Tags added during -*tagcommand
+evaluation do not register here. If tagName does
+not exist, it will be created with the default options.
+
+
+pathName tag cget tagName option
+This command returns the current value of the option
+named option associated with the tag given by tagName.
+Option may have any of the values accepted by the tag
+configure widget command.
+
+
+pathName tag col tagName ?col ...?
+With no arguments, prints out the list of cols that use
+the tag. Otherwise it sets the specified columns to use
+the named tag, replacing any tag that may have been set
+using this method before. If tagName is {}, the cols are
+reset to the default tag. Tags added during -coltagcommand
+evaluation do not register here. If tagName does
+not exist, it will be created with the default options.
+
+
+pathName tag configure tagName ?option? ?value? ?option value
+...?
+
+This command is similar to the configure widget command
+except that it modifies options associated with the tag
+given by tagName instead of modifying options for the
+overall table widget. If no option is specified, the
+command returns a list describing all of the available
+options for tagName (see Tk_ConfigureInfo for information
+on the format of this list). If option is specified with
+no value, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no option is
+specified). If one or more option-value pairs are specified,
+then the command modifies the given option(s) to
+have the given value(s) in tagName; in this case the command
+returns an empty string. See TAGS above for details
+on the options available for tags.
+
+
+pathName tag delete tagName
+
+Deletes a tag. No error if the tag does not exist.
+
+
+pathName tag exists tagName
+
+Returns 1 if the named tag exists, 0 otherwise.
+
+
+pathName tag includes tagName index
+Returns 1 if the specified index has the named tag, 0
+otherwise.
+
+
+pathName tag lower tagName ?belowThis?
+Lower the priority of the named tag. If belowThis is not
+specified, then the tag's priority is lowered to the bottom,
+otherwise it is lowered to one below belowThis.
+
+
+pathName tag names ?pattern?
+
+If no pattern is specified, shows the names of all
+defined tags. Otherwise the pattern is used as a glob
+pattern to show only tags matching that pattern. Tag
+names are returned in priority order (highest priority
+tag first).
+
+
+pathName tag raise tagName ?aboveThis?
+Raise the priority of the named tag. If aboveThis is not
+specified, then the tag's priority is raised to the top,
+otherwise it is raised to one above aboveThis.
+
+
+pathName tag row tagName ?row ...?
+With no arguments, prints out the list of rows that use
+the tag. Otherwise it sets the specified rows to use the
+named tag, replacing any tag that may have been set using
+this method before. If tagName is {}, the rows are reset
+to use the default tag. Tags added during -rowtagcommand
+evaluation do not register here. If tagName does not
+exist, it will be created with the default options.
+
+
+pathName validate index
+
+Explicitly validates the specified index based on the current
+-validatecommand and returns 0 or 1 based on whether the cell
+was validated.
+
+
+pathName width ?col? ?value col value ...?
+If no col is specified, returns a list describing all cols for
+which a width has been set. If col is specified with no value,
+it prints out the width of that col in characters (positive number)
+or pixels (negative number). If one or more col-value
+pairs are specified, then it sets each col to be that width in
+characters (positive number) or pixels (negative number). If
+value is default, then the col uses the default width, specified
+by -colwidth.
+
+
+pathName window option ?arg arg ...?
+
+This command is used to manipulate embedded windows. The exact
+behavior of the command depends on the option argument that follows
+the window argument. The following forms of the command
+are currently supported:
+
+
+pathName window cget index option
+This command returns the current value of the option
+named option associated with the window given by index.
+Option may have any of the values accepted by the window
+configure widget command.
+
+
+pathName window configure index ?option? ?value? ?option value
+...?
+
+This command is similar to the configure widget command
+except that it modifies options associated with the
+embedded window given by index instead of modifying
+options for the overall table widget. If no option is
+specified, the command returns a list describing all of
+the available options for index (see Tk_ConfigureInfo for
+information on the format of this list). If option is
+specified with no value, then the command returns a list
+describing the one named option (this list will be identical
+to the corresponding sublist of the value returned
+if no option is specified). If one or more option-value
+pairs are specified, then the command modifies the given
+option(s) to have the given value(s) in index; in this
+case the command returns an empty string. See EMBEDDED
+WINDOWS above for details on the options available for
+windows.
+
+
+pathName window delete index ?index ...?
+Deletes an embedded window from the table. The associated
+window will also be deleted.
+
+
+pathName window move indexFrom indexTo
+Moves an embedded window from one cell to another. If a
+window already exists in the target cell, it will be
+deleted.
+
+
+pathName window names ?pattern?
+
+If no pattern is specified, shows the cells of all embedded
+windows. Otherwise the pattern is used as a glob
+pattern to show only cells matching that pattern.
+
+
+pathName xview args
+
+This command is used to query and change the horizontal position
+of the information in the widget's window. It can take any of
+the following forms:
+
+
+pathName xview
+
+Returns a list containing two elements. Each element is
+a real fraction between 0 and 1; together they describe
+the horizontal span that is visible in the window. For
+example, if the first element is .2 and the second element
+is .6, 20% of the table's text is off-screen to the
+left, the middle 40% is visible in the window, and 40% of
+the text is off-screen to the right. These are the same
+values passed to scrollbars via the -xscrollcommand
+option.
+
+
+pathName xview index
+
+Adjusts the view in the window so that the column given
+by index is displayed at the left edge of the window.
+
+
+pathName xview moveto fraction
+
+Adjusts the view in the window so that fraction of the
+total width of the table text is off-screen to the left.
+fraction must be a fraction between 0 and 1.
+
+
+pathName xview scroll number what
+This command shifts the view in the window left or right
+according to number and what. Number must be an integer.
+What must be either units or pages or an abbreviation of
+one of these. If what is units, the view adjusts left or
+right by number cells on the display; if it is pages then
+the view adjusts by number screenfuls. If number is negative
+then cells farther to the left become visible; if
+it is positive then cells farther to the right become
+visible.
+
+
+pathName yview ?args?
+
+This command is used to query and change the vertical position
+of the text in the widget's window. It can take any of the following
+forms:
+
+
+pathName yview
+
+Returns a list containing two elements, both of which are
+real fractions between 0 and 1. The first element gives
+the position of the table element at the top of the window,
+relative to the table as a whole (0.5 means it is
+halfway through the table, for example). The second element
+gives the position of the table element just after
+the last one in the window, relative to the table as a
+whole. These are the same values passed to scrollbars
+via the -yscrollcommand option.
+
+
+pathName yview index
+
+Adjusts the view in the window so that the row given by
+index is displayed at the top of the window.
+
+
+pathName yview moveto fraction
+
+Adjusts the view in the window so that the element given
+by fraction appears at the top of the window. Fraction
+is a fraction between 0 and 1; 0 indicates the first
+element in the table, 0.33 indicates the element
+one-third the way through the table, and so on.
+
+
+pathName yview scroll number what
+This command adjusts the view in the window up or down
+according to number and what. Number must be an integer.
+What must be either units or pages. If what is units,
+the view adjusts up or down by number cells; if it is
+pages then the view adjusts by number screenfuls. If
+number is negative then earlier elements become visible;
+if it is positive then later elements become visible.
+
+
+
+
+
+The initialization creates class bindings that give the following
+default behaviour:
+
+
+
+
+- [1]
+- Clicking Button-1 in a cell activates that cell. Clicking into
+an already active cell moves the insertion cursor to the character
+nearest the mouse.
+
+
+
+- [2]
+- Moving the mouse while Button-1 is pressed will stroke out a
+selection area. Exiting while Button-1 is pressed causing scanning
+to occur on the table along with selection.
+
+
+
+- [3]
+- Moving the mouse while Button-2 is pressed causes scanning to
+occur without any selection.
+
+
+
+- [4]
+- Home moves the table to have the origin in view.
+
+
+
+- [5]
+- End moves the table to have the end cell in view.
+
+
+
+- [6]
+- Control-Home moves the table to the origin and activates that
+cell.
+
+
+
+- [7]
+- Control-End moves the table to the end and activates that cell.
+
+
+
+- [8]
+- Shift-Control-Home extends the selection to the origin.
+
+
+
+- [9]
+- Shift-Control-End extends the selection to the end.
+
+
+
+- [10]
+- The left, right, up and down arrows move the active cell.
+
+
+
+- [11]
+- Shift-<arrow> extends the selection in that direction.
+
+
+
+- [12]
+- Control-leftarrow and Control-rightarrow move the insertion cursor
+within the cell.
+
+
+
+- [13]
+- Control-slash selects all the cells.
+
+
+
+- [14]
+- Control-backslash clears selection from all the cells.
+
+
+
+
+[15] Backspace deletes the character before the insertion cursor in
+the active cell.
+
+
+[16] Delete deletes the character after the insertion cursor in the
+active cell.
+
+
+[17] Escape rereads the value of the active cell from the specified
+data source, discarding any edits that have may been performed
+on the cell.
+
+
+[18] Control-a moves the insertion cursor to the beginning of the
+active cell.
+
+
+[19] Control-e moves the insertion cursor to the end of the active
+cell.
+
+
+
+
+- [20]
+- Control-minus and Control-equals decrease and increase the width
+of the column with the active cell in it.
+
+
+
+- [21]
+- Moving the mouse while Button-3 (the right button on Windows) is
+pressed while you are over a border will cause interactive
+resizing of that row and/or column to occur, based on the value
+of -resizeborders.
+
+
+
+
+Some bindings may have slightly different behavior dependent on the
+-selectionmode of the widget.
+
+
+If the widget is disabled using the -state option, then its view can
+still be adjusted and cells can still be selected, but no insertion
+cursor will be displayed and no cell modifications will take place.
+
+
+The behavior of tables can be changed by defining new bindings for
+individual widgets or by redefining the class bindings. The default
+bindings are either compiled in or read from a file expected to correspond
+to: [lindex $tcl_pkgPath 0]/Tktable<version>/tkTable.tcl".
+
+
+
+
+
+The number of rows and columns or a table widget should not significantly
+affect the speed of redraw. Recalculation and redraw of table
+parameters and cells is restricted as much as possible.
+
+
+The display cell with the insert cursor is redrawn each time the cursor
+blinks, which causes a steady stream of graphics traffic. Set the
+-insertofftime option to 0 avoid this. The use of a -command with the
+table without a cache can cause significant slow-down, as the command
+is called once for each request of a cell value.
+
+
+
+
+
+Set the topleft title area to be one spanning cell. This overestimates
+both row and column span by one, but the command does all the constraining
+for us.
+
+$table span [$table cget -roworigin],[$table cget -colorigin] [$table cget -titlerows],[$table cget -titlecols]
+Force a table window refresh (useful for the slight chance that a bug
+in the table is not causing proper refresh):
+$table configure -padx [$table cget -padx]
+
+
+
+
+
+table, widget, extension
+
+
+
+Table of Contents
+
+
+
diff --git a/tktable/doc/tkTable.n b/tktable/doc/tkTable.n
new file mode 100644
index 0000000..7b7b432
--- /dev/null
+++ b/tktable/doc/tkTable.n
@@ -0,0 +1,1432 @@
+'\"
+'\" The definitions below are for supplemental macros used in Tcl/Tk
+'\" manual entries.
+'\"
+'\" RCS: @(#) $Id: tkTable.n,v 1.13 2008/11/14 22:51:30 hobbs Exp $
+'\"
+'\" .AP type name in/out ?indent?
+'\" Start paragraph describing an argument to a library procedure.
+'\" type is type of argument (int, etc.), in/out is either "in", "out",
+'\" or "in/out" to describe whether procedure reads or modifies arg,
+'\" and indent is equivalent to second arg of .IP (shouldn't ever be
+'\" needed; use .AS below instead)
+'\"
+'\" .AS ?type? ?name?
+'\" Give maximum sizes of arguments for setting tab stops. Type and
+'\" name are examples of largest possible arguments that will be passed
+'\" to .AP later. If args are omitted, default tab stops are used.
+'\"
+'\" .BS
+'\" Start box enclosure. From here until next .BE, everything will be
+'\" enclosed in one large box.
+'\"
+'\" .BE
+'\" End of box enclosure.
+'\"
+'\" .CS
+'\" Begin code excerpt.
+'\"
+'\" .CE
+'\" End code excerpt.
+'\"
+'\" .VS ?br?
+'\" Begin vertical sidebar, for use in marking newly-changed parts
+'\" of man pages. If an argument is present, then a line break is
+'\" forced before starting the sidebar.
+'\"
+'\" .VE
+'\" End of vertical sidebar.
+'\"
+'\" .DS
+'\" Begin an indented unfilled display.
+'\"
+'\" .DE
+'\" End of indented unfilled display.
+'\"
+'\" .SO
+'\" Start of list of standard options for a Tk widget. The
+'\" options follow on successive lines, in four columns separated
+'\" by tabs.
+'\"
+'\" .SE
+'\" End of list of standard options for a Tk widget.
+'\"
+'\" .OP cmdName dbName dbClass
+'\" Start of description of a specific option. cmdName gives the
+'\" option's name as specified in the class command, dbName gives
+'\" the option's name in the option database, and dbClass gives
+'\" the option's class in the option database.
+'\"
+'\" .UL arg1 arg2
+'\" Print arg1 underlined, then print arg2 normally.
+'\"
+'\" # Set up traps and other miscellaneous stuff for Tcl/Tk man pages.
+.if t .wh -1.3i ^B
+.nr ^l \n(.l
+.ad b
+'\" # Start an argument description
+.de AP
+.ie !'\\$4'' .TP \\$4
+.el \{\
+. ie !'\\$2'' .TP \\n()Cu
+. el .TP 15
+.\}
+.ie !'\\$3'' \{\
+.ta \\n()Au \\n()Bu
+\&\\$1 \\fI\\$2\\fP (\\$3)
+.\".b
+.\}
+.el \{\
+.br
+.ie !'\\$2'' \{\
+\&\\$1 \\fI\\$2\\fP
+.\}
+.el \{\
+\&\\fI\\$1\\fP
+.\}
+.\}
+..
+'\" # define tabbing values for .AP
+.de AS
+.nr )A 10n
+.if !'\\$1'' .nr )A \\w'\\$1'u+3n
+.nr )B \\n()Au+15n
+.\"
+.if !'\\$2'' .nr )B \\w'\\$2'u+\\n()Au+3n
+.nr )C \\n()Bu+\\w'(in/out)'u+2n
+..
+.AS Tcl_Interp Tcl_CreateInterp in/out
+'\" # BS - start boxed text
+'\" # ^y = starting y location
+'\" # ^b = 1
+.de BS
+.br
+.mk ^y
+.nr ^b 1u
+.if n .nf
+.if n .ti 0
+.if n \l'\\n(.lu\(ul'
+.if n .fi
+..
+'\" # BE - end boxed text (draw box now)
+.de BE
+.nf
+.ti 0
+.mk ^t
+.ie n \l'\\n(^lu\(ul'
+.el \{\
+.\" Draw four-sided box normally, but don't draw top of
+.\" box if the box started on an earlier page.
+.ie !\\n(^b-1 \{\
+\h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul'
+.\}
+.el \}\
+\h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul'
+.\}
+.\}
+.fi
+.br
+.nr ^b 0
+..
+'\" # VS - start vertical sidebar
+'\" # ^Y = starting y location
+'\" # ^v = 1 (for troff; for nroff this doesn't matter)
+.de VS
+.if !'\\$1'' .br
+.mk ^Y
+.ie n 'mc \s12\(br\s0
+.el .nr ^v 1u
+..
+'\" # VE - end of vertical sidebar
+.de VE
+.ie n 'mc
+.el \{\
+.ev 2
+.nf
+.ti 0
+.mk ^t
+\h'|\\n(^lu+3n'\L'|\\n(^Yu-1v\(bv'\v'\\n(^tu+1v-\\n(^Yu'\h'-|\\n(^lu+3n'
+.sp -1
+.fi
+.ev
+.\}
+.nr ^v 0
+..
+'\" # Special macro to handle page bottom: finish off current
+'\" # box/sidebar if in box/sidebar mode, then invoked standard
+'\" # page bottom macro.
+.de ^B
+.ev 2
+'ti 0
+'nf
+.mk ^t
+.if \\n(^b \{\
+.\" Draw three-sided box if this is the box's first page,
+.\" draw two sides but no top otherwise.
+.ie !\\n(^b-1 \h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c
+.el \h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c
+.\}
+.if \\n(^v \{\
+.nr ^x \\n(^tu+1v-\\n(^Yu
+\kx\h'-\\nxu'\h'|\\n(^lu+3n'\ky\L'-\\n(^xu'\v'\\n(^xu'\h'|0u'\c
+.\}
+.bp
+'fi
+.ev
+.if \\n(^b \{\
+.mk ^y
+.nr ^b 2
+.\}
+.if \\n(^v \{\
+.mk ^Y
+.\}
+..
+'\" # DS - begin display
+.de DS
+.RS
+.nf
+.sp
+..
+'\" # DE - end display
+.de DE
+.fi
+.RE
+.sp
+..
+'\" # SO - start of list of standard options
+.de SO
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+.ft B
+..
+'\" # SE - end of list of standard options
+.de SE
+.fi
+.ft R
+.LP
+See the \\fBoptions\\fR manual entry for details on the standard options.
+..
+'\" # OP - start of full description for a single option
+.de OP
+.LP
+.nf
+.ta 4c
+Command-Line Name: \\fB\\$1\\fR
+Database Name: \\fB\\$2\\fR
+Database Class: \\fB\\$3\\fR
+.fi
+.IP
+..
+'\" # CS - begin code excerpt
+.de CS
+.RS
+.nf
+.ta .25i .5i .75i 1i
+..
+'\" # CE - end code excerpt
+.de CE
+.fi
+.RE
+..
+.de UL
+\\$1\l'|0\(ul'\\$2
+..
+.TH table n 2.8 Tk "Tk Table Extension"
+.HS table tk
+.BS
+.SH NAME
+table \- Create and manipulate tables
+.SH SYNOPSIS
+\fBtable\fI \fIpathName \fR?\fIoptions\fR?
+.SO
+\-anchor \-background \-cursor
+\-exportselection \-font \-foreground
+\-highlightbackground \-highlightcolor \-highlightthickness
+\-insertbackground \-insertborderwidth \-insertofftime
+\-insertontime \-insertwidth \-invertselected
+\-relief \-takefocus \-xscrollcommand
+\-yscrollcommand
+.SE
+
+.SH "WIDGET-SPECIFIC OPTIONS"
+.OP \-autoclear autoClear AutoClear
+A boolean value which specifies whether the first keypress in a cell will
+delete whatever text was previously there. Defaults to 0.
+.OP \-bordercursor borderCursor Cursor
+Specifies the name of the cursor to show when over borders, a visual
+indication that interactive resizing is allowed (it is thus affect by
+the value of \-resizeborders). Defaults to \fIcrosshair\fR.
+.OP "\-borderwidth or \-bd" borderWidth BorderWidth
+Specifies a non-negative pixel value or list of values indicating the width
+of the 3-D border to draw on interior table cells (if such a border is
+being drawn; the \fBrelief\fR option typically determines this). If one
+value is specified, a rectangle of this width will be drawn. If two values
+are specified, then only the left and right edges of the cell will have
+borders. If four values are specified, then the values correspond to the
+{left right top bottom} edges. This can be overridden by the a tag's
+borderwidth option. It can also be affected by the defined
+\fB\-drawmode\fR for the table. Each value in the list must have one of
+the forms acceptable to \fBTk_GetPixels\fR.
+.OP "\-browsecommand or \-browsecmd" browseCommand BrowseCommand
+Specifies a command which will be evaluated anytime the active cell changes.
+It uses the %\-substition model described in COMMAND SUBSTITUTION below.
+Any changes to the active cell while the command is running are ignored to
+prevent recursion.
+.OP \-cache cache Cache
+A boolean value that specifies whether an internal cache of the table
+contents should be kept. This greatly enhances speed performance when used
+with \fB\-command\fR but uses extra memory. Can maintain state when both
+\fB\-command\fR and \fB\-variable\fR are empty. The cache is automatically
+flushed whenever the value of \fB\-cache\fR or \fB\-variable\fR changes,
+otherwise you have to explicitly call \fBclear\fR on it. Defaults to off.
+.OP \-colorigin colOrigin Origin
+Specifies what column index to interpret as the leftmost column in the table.
+This value is used for user indices in the table. Defaults to 0.
+.OP \-cols cols Cols
+Number of cols in the table. Defaults to 10.
+.OP \-colseparator colSeparator Separator
+Specifies a separator character that will be interpreted as the column
+separator when cutting or pasting data in a table. By default, columns
+are separated as elements of a tcl list.
+.OP \-colstretchmode colStretchMode StretchMode
+Specifies one of the following stretch modes for columns to fill extra
+allocated window space:
+.RS
+.TP
+\fBnone\fR
+Columns will not stretch to fill the assigned window space. If the columns
+are too narrow, there will be a blank space at the right of the table. This
+is the default.
+.TP
+\fBunset\fR
+Only columns that do not have a specific width set will be stretched.
+.TP
+\fBall\fR
+All columns will be stretched by the same number of pixels to fill the
+window space allocated to the table. This mode can interfere with
+interactive border resizing which tries to force column width.
+.TP
+\fBlast\fR
+The last column will be stretched
+to fill the window space allocated to the table.
+.TP
+\fBfill\fR (only valid for \fB\-rowstretch\fR currently)
+The table will get more or less columns according to the window
+space allocated to the table. This mode has numerous quirks and
+may disappear in the future.
+.RE
+.OP \-coltagcommand colTagCommand TagCommand
+Provides the name of a procedure that will be evaluated by the widget to
+determine the tag to be used for a given column. When displaying a cell,
+the table widget will first check to see if a tag has been defined using the
+\fBtag col\fR widget method. If no tag is found, it will evaluate the named
+procedure passing the column number in question as the sole argument. The
+procedure is expected to return the name of a tag to use, or a null string.
+Errors occurring during the evaluation of the procedure, or the return of an
+invalid tag name are silently ignored.
+.OP \-colwidth colWidth ColWidth
+Default column width, interpreted as characters in the default font when
+the number is positive, or pixels if it is negative. Defaults to 10.
+.OP \-command command Command
+Specified a command to use as a procedural interface to cell values.
+If \fB\-usecommand\fR is true, this command will be used instead of any
+reference to the \fB\-variable\fR array. When retrieving cell values,
+the return value of the command is used as the value for the cell.
+It uses the %\-substition model described in COMMAND SUBSTITUTION below.
+.OP \-drawmode drawMode DrawMode
+Sets the table drawing mode to one of the following options:
+.RS
+.TP
+\fBslow\fR
+The table is drawn to an offscreen pixmap using the Tk bordering functions
+(double-buffering). This means there will be no flashing, but this mode is
+slow for larger tables.
+.TP
+\fBcompatible\fR
+The table is drawn directly to the screen using the Tk border functions.
+It is faster, but the screen may flash on update. This is the default.
+.TP
+\fBfast\fR
+The table is drawn directly to the screen and the borders are done with
+fast X calls, so they are always one pixel wide only. As a side effect, it
+restricts \fB\-borderwidth\fR to a range of 0 or 1. This mode provides
+best performance for large tables, but can flash on redraw and is not 100%
+Tk compatible on the border mode.
+.TP
+\fBsingle\fR
+The table is drawn to the screen as in fast mode, but only single pixel
+lines are drawn (not square borders).
+.RE
+.OP \-ellipsis ellipsis Ellipsis
+This specifies a string to display at the end of a line that would be
+clipped by its cell, like ``...''. An ellipsis will be displayed only
+on non-wrapping, non-multiline cells that would be clipped. The ellipsis
+will display on the left for east anchored cells, otherwise it displays
+on the right.
+Defaults to "" (no ellipsis).
+.OP \-flashmode flashMode FlashMode
+A boolean value which specifies whether cells should flash when their value
+changes. The table tag \fBflash\fR will be applied to these cells for the
+duration specified by \fB\-flashtime\fR. Defaults to 0.
+.OP \-flashtime flashTime FlashTime
+The amount of time, in 1/4 second increments, for which a cell should flash
+when its value has changed. \fB\-flashmode\fR must be on. Defaults to 2.
+.OP \-height height Height
+Specifies the desired height for the window, in rows.
+If zero or less, then the desired height for the window is made just
+large enough to hold all the rows in the table. The height can be
+further limited by \fB\-maxheight\fR.
+.OP \-invertselected invertSelected InvertSelected
+Specifies whether the foreground and background of an item should simply
+have their values swapped instead of merging the \fIsel\fR tag options
+when the cell is selected. Defaults to 0 (merge \fIsel\fR tag).
+.OP \-ipadx ipadX Pad
+A pixel value specifying the internal offset X padding for text in a cell.
+This value does not grow the size of the cell, it just causes the text to
+be drawn further from the cell border. It only affects one side (depending
+on anchor). Defaults to 0. See \fB\-padx\fR for an alternate padding
+style.
+.OP \-ipady ipadY Pad
+A pixel value specifying the internal offset Y padding for text in a cell.
+This value does not grow the size of the cell, it just causes the text to
+be drawn further from the cell border. It only affects one side (depending
+on anchor). Defaults to 0. See \fB\-pady\fR for an alternate padding
+style.
+.OP \-justify justify Justify
+How to justify multi\-line text in a cell.
+It must be one of \fBleft\fR, \fBright\fR, or \fBcenter\fR.
+Defaults to left.
+.OP \-maxheight maxHeight MaxHeight
+The max height in pixels that the window will request. Defaults to 600.
+.OP \-maxwidth maxWidth MaxWidth
+The max width in pixels that the window will request. Defaults to 800.
+.OP \-multiline multiline Multiline
+Specifies the default setting for the multiline tag option. Defaults to 1.
+.OP \-padx padX Pad
+A pixel value specifying the offset X padding for a cell. This value
+causes the default size of the cell to increase by two times the value (one
+for each side), unless a specific pixel size is chosen for the cell with
+the \fBwidth\fR command. This will force an empty area on the left and
+right of each cell edge. This padding affects all types of data in the
+cell. Defaults to 0. See \fB\-ipadx\fR for an alternate padding style.
+.OP \-pady padY Pad
+A pixel value specifying the offset Y padding for a cell. This value
+causes the default size of the cell to increase by two times the value (one
+for each side), unless a specific pixel size is chosen for the cell with
+the \fBheight\fR command. This will force an empty area on the top and
+bottom of each cell edge. This padding affects all types of data in the
+cell. Defaults to 0. See \fB\-ipadx\fR for an alternate padding style.
+.OP \-resizeborders resizeBorders ResizeBorders
+Specifies what kind of interactive border resizing to allow, must be one of
+row, col, both (default) or none.
+.OP \-rowheight rowHeight RowHeight
+Default row height, interpreted as lines in the default font when
+the number is positive, or pixels if it is negative. Defaults to 1.
+.OP \-roworigin rowOrigin Origin
+Specifies what row index to interpret as the topmost row in the table.
+This value is used for user indices in the table. Defaults to 0.
+.OP \-rows rows Rows
+Number of rows in the table. Defaults to 10.
+.OP \-rowseparator rowSeparator Separator
+Specifies a separator character that will be interpreted as the row
+separator when cutting or pasting data in a table. By default, rows
+are separated as tcl lists.
+.OP \-rowstretchmode rowStretchMode StretchMode
+Specifies the stretch modes for rows to fill extra
+allocated window space. See \fB\-colstretchmode\fR for valid options.
+.OP \-rowtagcommand rowTagCommand TagCommand
+Provides the name of a procedure that can evaluated by the widget to
+determine the tag to be used for a given row. The procedure must be
+defined by the user to accept a single argument (the row number), and
+return a tag name or null string. This operates in a similar manner as
+\fB\-coltagcommand\fR, except that it applies to row tags.
+.OP "\-selectioncommand or \-selcmd" selectionCommand SelectionCommand
+Specifies a command to evaluate when the selection is retrieved from a
+table via the selection mechanism (ie: evaluating ``\fBselection get\fR'').
+The return value from this command will become the string passed on by the
+selection mechanism. It uses the %\-substition model described in COMMAND
+SUBSTITUTION below. If an error occurs, a Tcl background error is
+generated and nothing is returned.
+.OP \-selectmode selectMode SelectMode
+Specifies one of several styles for manipulating the selection. The value
+of the option may be arbitrary, but the default bindings expect it to be
+either \fBsingle\fR, \fBbrowse\fR, \fBmultiple\fR, or \fBextended\fR; the
+default value is \fBbrowse\fR. These styles are like those for the Tk
+listbox, except expanded for 2 dimensions.
+.OP \-selecttitle selectTitles SelectTitles
+Specifies whether title cells should be allowed in the selection.
+Defaults to 0 (disallowed).
+.OP \-selecttype selectType SelectType
+Specifies one of several types of selection for the table. The value of the
+option may be one of \fBrow\fR, \fBcol\fR, \fBcell\fR, or \fBboth\fR
+(meaning \fBrow && col\fR); the default value is \fBcell\fR. These types
+define whether an entire row/col is affected when a cell's selection is
+changed (set or clear).
+.OP \-sparsearray sparseArray SparseArray
+A boolean value that specifies whether an associated Tcl array should be
+kept as a sparse array (1, the default) or as a full array (0). If true,
+then cell values that are empty will be deleted from the array (taking
+less memory). If false, then all values in the array will be maintained.
+.OP \-state state State
+Specifies one of two states for the entry: \fBnormal\fR or \fBdisabled\fR.
+If the table is disabled then the value may not be changed using widget
+commands and no insertion cursor will be displayed, even if the input focus
+is in the widget. Also, all insert or delete methods will be ignored.
+Defaults to \fBnormal\fR.
+.OP \-titlecols titleCols TitleCols
+Number of columns to use as a title area. Defaults to 0.
+.OP \-titlerows titleRows TitleRows
+Number of rows to use as a title area. Defaults to 0.
+.OP \-usecommand useCommand UseCommand
+A boolean value which specifies whether to use the \fBcommand\fR option.
+This value sets itself to zero if \fBcommand\fR is used and returns an error.
+Defaults to 1 (will use \fBcommand\fR if specified).
+.OP \-validate validate Validate
+A boolean specifying whether validation should occur for the active buffer.
+Defaults to 0.
+.OP "\-validatecommand or \-vcmd" validateCommand ValidateCommand
+Specifies a command to execute when the active cell is edited. This command
+is expected to return a Tcl boolean. If it returns true, then it is assumed
+the new value is OK, otherwise the new value is rejected (the edition will
+not take place). Errors in this command are handled in the background. It
+uses the %\-substition model described in COMMAND SUBSTITUTION below.
+.OP \-variable variable Variable
+Global Tcl array variable to attach to the table's C array. It will be
+created if it doesn't already exist or is a simple variable. Keys used by
+the table in the array are of the form \fIrow\fR,\fIcol\fR for cells and
+the special key \fIactive\fR which contains the value of the active cell
+buffer. The Tcl array is managed as a sparse array (the table does not
+require that all valid indices have values). No stored value for an index is
+equivalent to the empty string, and clearing a cell will remove that index
+from the Tcl array, unless the \fB\-sparsearray\fR options is set to 0.
+.OP \-width width Width
+Specifies the desired width for the window, in columns.
+If zero or less, then the desired width for the window is made just
+large enough to hold all the columns in the table. The width can be
+further limited by \fB\-maxwidth\fR.
+.OP \-wrap wrap Wrap
+Specifies the default wrap value for tags. Defaults to 0.
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBtable\fR command creates a 2\-dimensional grid of cells. The table
+can use a Tcl array variable or Tcl command for data storage and retrieval,
+as well as optionally cache data in memory for speed. One of these data
+sources \fImust\fR be configured before any data is retained by the table.
+The widget has an active cell, the contents of which can be edited (when
+the state is normal). The widget supports a default style for the cells
+and also multiple \fItags\fR, which can be used to change the style of a
+row, column or cell (see TAGS for details). A cell \fIflash\fR can be set
+up so that changed cells will change color for a specified amount of time
+("blink"). Cells can have embedded images or windows, as described in
+TAGS and "EMBEDDED WINDOWS" respectively.
+.PP
+One or more cells may be selected as described below. If a table is
+exporting its selection (see \fB\-exportselection\fR option), then it will
+observe the standard X11 protocols for handling the selection. See THE
+SELECTION for details.
+.PP
+It is not necessary for all the cells to be displayed in the table window at
+once; commands described below may be used to change the view in the window.
+Tables allow scrolling in both directions using the standard
+\fB\-xscrollcommand\fR and \fB\-yscrollcommand\fR options. They also support
+scanning, as described below.
+.PP
+In order to obtain good performance, the table widget supports multiple
+drawing modes, two of which are fully Tk compatible.
+
+.SH "INITIALIZATION"
+.PP
+When the \fBtable\fR command is loaded into an interpreter, a built-in
+Tcl command, \fBtkTableInit\fR, is evaluated. This will search for the
+appropriate table binding init file to load. The directories searched
+are those in \fI$tcl_pkgPath\fR, both with Tktable(version) appended and
+without, \fI$tk_library\fR and \fI[pwd]\fR (the current directory). You
+can also define an \fI$env(TK_TABLE_LIBRARY)\fR to head this search list.
+By default, the file searched for is called \fBtkTable.tcl\fR, but this
+can be overridden by setting \fI$env(TK_TABLE_LIBRARY_FILE)\fR.
+.PP
+This entire init script can be overridden by providing your own
+\fBtkTableInit\fR procedure before the library is loaded. Otherwise, the
+aforementioned \fIenv(TK_TABLE_LIBRARY)\fR variable will be set with the
+directory in which \fI$env(TK_TABLE_LIBRARY_FILE)\fR was found.
+
+.SH "INDICES"
+.PP
+Many of the widget commands for tables take one or more indices as arguments.
+An index specifies a particular cell of the table, in any of
+the following ways:
+.TP 12
+\fInumber,number\fR
+Specifies the cell as a numerical index of row,col which corresponds to the
+index of the associated Tcl array, where \fB\-roworigin,\-colorigin\fR
+corresponds to the first cell in the table (0,0 by default). The values
+for row and column will be constrained to actual values in the table,
+which means a valid cell is always found.
+.TP 12
+\fBactive\fR
+Indicates the cell that has the location cursor.
+It is specified with the \fBactivate\fR widget command.
+.TP 12
+\fBanchor\fR
+Indicates the anchor point for the selection, which is set with the
+\fBselection anchor\fR widget command.
+.TP 12
+\fBbottomright\fR
+Indicates the bottom\-rightmost cell visible in the table.
+.TP 12
+\fBend\fR
+Indicates the bottom right cell of the table.
+.TP 12
+\fBorigin\fR
+Indicates the top\-leftmost editable cell of the table, not necessarily
+in the display. This takes into account the user specified origin and
+title area.
+.TP 12
+\fBtopleft\fR
+Indicates the top\-leftmost editable cell visible in the table (this
+excludes title cells).
+.TP 12
+\fB@\fIx\fB,\fIy\fR
+Indicates the cell that covers the point in the table window
+specified by \fIx\fR and \fIy\fR (in pixel coordinates). If no
+cell covers that point, then the closest cell to that
+point is used.
+.LP
+In the widget command descriptions below, arguments named \fIindex\fR,
+\fIfirst\fR, and \fIlast\fR always contain text indices in one of
+the above forms.
+
+.SH TAGS
+.PP
+A tag is a textual string that is associated with zero or more rows,
+columns or cells in a table. Tags may contain arbitrary characters, but it
+is probably best to avoid using names which look like indices to reduce
+coding confusion. A tag can apply to an entire row or column, or just a
+single cell. There are several permanent tags in each table that can be
+configured by the user and will determine the attributes for special cells:
+.RS
+.TP 10
+\fBactive\fR
+This tag is given to the \fIactive\fR cell
+.TP 10
+\fBflash\fR
+If flash mode is on, this tag is given to any recently
+edited cells.
+.TP 10
+\fBsel\fR
+This tag is given to any selected cells.
+.TP 10
+\fBtitle\fR
+This tag is given to any cells in the title rows and columns. This
+tag has \fB\-state\fR \fIdisabled\fR by default.
+.RE
+.PP
+Tags control the way cells are displayed on the screen. Where appropriate,
+the default for displaying cells is determined by the options for the table
+widget. However, display options may be associated with individual tags
+using the ``\fIpathName \fBtag configure\fR'' widget command. If a cell,
+row or column has been tagged, then the display options associated with the
+tag override the default display style. The following options are
+currently supported for tags:
+.RS
+.TP
+\fB\-anchor\fR \fIanchor\fR
+Anchor for item in the cell space.
+.TP
+\fB\-background\fR or \fB\-bg\fR \fIcolor\fR
+Background color of the cell.
+.TP
+\fB\-borderwidth\fR or \fB\-bd\fR \fIpixelList\fR
+Borderwidth of the cell, of the same format for the table, but may also
+be empty to inherit the default table borderwidth value (the default).
+.TP
+\fB\-ellipsis\fR \fIstring\fR
+String to display at the end of a line that would be clipped by its cell,
+like ``...''. An ellipsis will be displayed only
+on non-wrapping, non-multiline cells that would be clipped. The ellipsis
+will display on the left for east anchored cells, otherwise it displays
+on the right.
+.TP
+\fB\-font\fR \fIfontName\fR
+Font for text in the cell.
+.TP
+\fB\-foreground\fR or \fB\-fg\fR \fIcolor\fR
+Foreground color of the cell.
+.TP
+\fB\-justify\fR \fIjustify\fR
+How to justify multi\-line text in a cell.
+It must be one of \fBleft\fR, \fBright\fR, or \fBcenter\fR.
+.TP
+\fB\-image\fR \fIimageName\fR
+An image to display in the cell instead of text.
+.TP
+\fB\-multiline\fR \fIboolean\fR
+Whether to display text with newlines on multiple lines.
+.TP
+\fB\-relief\fR \fIrelief\fR
+The relief for the cell. May be the empty string to cause this tag to
+not disturb the value.
+.TP
+\fB\-showtext\fR \fIboolean\fR
+Whether to show the text over an image.
+.TP
+\fB\-state\fR \fIstate\fR
+The state of the cell, to allow for certain cells to be disabled.
+This prevents the cell from being edited by the \fIinsert\fR or \fIdelete\fR
+methods, but a direct \fIset\fR will not be prevented.
+.TP
+\fB\-wrap\fR \fIboolean\fR
+Whether characters should wrap in a cell that is not wide enough.
+.RE
+.PP
+A priority order is defined among tags based on creation order (first
+created tag has highest default priority), and this order is used in
+implementing some of the tag\-related functions described below. When a cell
+is displayed, its properties are determined by the tags which are assigned
+to it. The priority of a tag can be modified by the ``\fIpathName \fBtag
+lower\fR'' and ``\fIpathName \fBtag raise\fR'' widget commands.
+.PP
+If a cell has several tags associated with it that define the same display
+options (eg - a \fBtitle\fR cell with specific \fBrow\fR and \fBcell\fR
+tags), then the options of the highest priority tag are used. If a
+particular display option hasn't been specified for a particular tag, or if
+it is specified as an empty string, then that option will not be used; the
+next\-highest\-priority tag's option will be used instead. If no tag
+specifies a particular display option, then the default style for the
+widget will be used.
+.PP
+Images are used for display purposes only. Editing in that cell will still
+be enabled and any querying of the cell will show the text value of the cell,
+regardless of the value of \fB\-showtext\fR.
+
+.SH "EMBEDDED WINDOWS"
+.PP
+There may be any number of embedded windows in a table widget (one per
+cell), and any widget may be used as an embedded window (subject to the
+usual rules for geometry management, which require the table window to be
+the parent of the embedded window or a descendant of its parent). The
+embedded window's position on the screen will be updated as the table is
+modified or scrolled, and it will be mapped and unmapped as it moves into
+and out of the visible area of the table widget. Each embedded window
+occupies one cell's worth of space in the table widget, and it is referred
+to by the index of the cell in the table. Windows associated with the
+table widget are destroyed when the table widget is destroyed.
+.PP
+Windows are used for display purposes only. A value still exists for that
+cell, but will not be shown unless the window is deleted in some way. If
+the window is destroyed or lost by the table widget to another geometry
+manager, then any data associated with it is lost (the cell it occupied
+will no longer appear in \fBwindow names\fR).
+.PP
+When an embedded window is added to a table widget with the window
+configure widget command, several configuration options may be associated
+with it. These options may be modified with later calls to the window
+configure widget command. The following options are currently supported:
+.RS
+.TP
+\fB\-create \fIscript\fR
+NOT CURRENTLY SUPPORTED. Specifies a Tcl script that may be evaluated to
+create the window for the annotation. If no \-window option has been
+specified for this cell then this script will be evaluated when the
+cell is about to be displayed on the screen. Script must create a
+window for the cell and return the name of that window as its result.
+If the cell's window should ever be deleted, the script will be evaluated
+again the next time the cell is displayed.
+.TP
+\fB\-background\fR or \fB\-bg\fR \fIcolor\fR
+Background color of the cell. If not
+specified, it uses the table's default background.
+.TP
+\fB\-borderwidth\fR or \fB\-bd\fR \fIpixelList\fR
+Borderwidth of the cell, of the same format for the table, but may also
+be empty to inherit the default table borderwidth value (the default).
+.TP
+\fB\-padx \fIpixels\fR
+As defined in the Tk options man page.
+.TP
+\fB\-pady \fIpixels\fR
+As defined in the Tk options man page.
+.TP
+\fB\-relief \fIrelief\fR
+The relief to use for the cell in which the window lies. If not
+specified, it uses the table's default relief.
+.TP
+\fB\-sticky \fIsticky\fR
+Stickiness of the window inside the cell, as defined by the \fBgrid\fR command.
+.TP
+\fB\-window \fIpathName\fR
+Specifies the name of a window (widget) to display in the annotation. It
+must exist before being specified here. When an empty string is specified,
+if a window was displayed it will cease to be managed by the table widget.
+.RE
+
+.SH "THE SELECTION"
+.PP
+Table selections are available as type STRING. By default, the value of
+the selection will be the values of the selected cells in nested Tcl list
+form where each row is a list and each column is an element of a row list.
+You can change the way this value is interpreted by setting the
+\fB\-rowseparator\fR and \fB\-colseparator\fR options. For example,
+default Excel format would be to set \fB\-rowseparator\fR to '\\n' and
+\fB\-colseparator\fR to '\\t'. Changing these values affects both how the
+table sends out the selection and reads in pasted data, ensuring that the
+table should always be able to cut and paste to itself. It is possible to
+change how pastes are handled by editing the table library procedure
+\fBtk_tablePasteHandler\fR. This might be necessary if
+\fB\-selectioncommand\fR is set.
+
+.SH "ROW/COL SPANNING"
+.PP
+Individual cells can span multiple rows and/or columns. This is done
+via the \fBspans\fR command (see below for exact arguments). Cells in
+the title area that span are not permitted to span beyond the title area,
+and will be constrained accordingly. If the title area shrinks during a
+configure, sanity checking will occur to ensure the above. You may set
+spans on regular cells that extend beyond the defined row/col area. These
+spans will not be constrained, so that when the defined row/col area
+expands, the span will expand with it.
+.PP
+When setting a span, checks are made as to whether the span would overlap
+an already spanning or hidden cell. This is an error and it not allowed.
+Spans can affect the overall speed of table drawing, although not
+significantly. If spans are not used, then there is no performance loss.
+.PP
+Cells \fIhidden\fR by spanning cells still have valid data. This will
+be seen during cut and paste operations that involve hidden cells, or
+through direct access by a command like \fBget\fR or \fBset\fR.
+.PP
+The drawing properties of spanning cells apply to only the visual area
+of the cell. For example, if a cell is center justified over 5 columns,
+then when viewing any portion of those columns, it will appear centered
+in the visible area. The non-visible column area will not be considered
+in the centering calculations.
+
+.SH "COMMAND SUBSTITUTION"
+.PP
+
+The various option based commands that the table supports all support the
+familiar Tk %\-substitution model (see \fBbind\fR for more details). The
+following %\-sequences are recognized and substituted by the table widget:
+.TP 5
+\fB%c\fR
+For \fBSelectionCommand\fR, it is the maximum number of columns in any
+row in the selection. Otherwise it is the column of the triggered cell.
+.TP 5
+\fB%C\fR
+A convenience substitution for \fI%r\fR,\fI%c\fR.
+.TP 5
+\fB%i\fR
+For \fBSelectionCommand\fR, it is the total number of cells in the selection.
+For \fBCommand\fR, it is 0 for a read (get) and 1 for a write (set).
+Otherwise it is the current cursor position in the cell.
+.TP 5
+\fB%r\fR
+For \fBSelectionCommand\fR, it is the number of rows in the selection.
+Otherwise it is the row of the triggered cell.
+.TP 5
+\fB%s\fR
+For \fBValidateCommand\fR, it is the current value of the cell being validated.
+For \fBSelectionCommand\fR, it is the default value of the selection.
+For \fBBrowseCommand\fR, it is the index of the last active cell.
+For \fBCommand\fR, it is empty for reads (get) and the current value of the
+cell for writes (set).
+.TP 5
+\fB%S\fR
+For \fBValidateCommand\fR, it is the potential new value of the cell
+being validated.
+For \fBBrowseCommand\fR, it is the index of the new active cell.
+.TP 5
+\fB%W\fR
+The pathname to the window for which the command was generated.
+.LP
+
+.SH "WIDGET COMMAND"
+.PP
+The \fBtable\fR command creates a new Tcl command whose
+name is \fIpathName\fR. This command may be used to invoke various
+operations on the widget. It has the following general form:
+.CS
+\fIpathName option \fR?\fIarg arg ...\fR?
+.CE
+\fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command.
+.PP
+The following commands are possible for \fBtable\fR widgets:
+.TP
+\fIpathName \fBactivate\fR \fIindex\fR
+Sets the active cell to the one indicated by \fIindex\fR.
+.TP
+\fIpathName \fBbbox\fR \fIfirst\fR ?\fIlast\fR?
+It returns the bounding box for the specified cell (range) as a 4\-tuple of
+x, y, width and height in pixels. It clips the box to the visible portion,
+if any, otherwise an empty string is returned.
+.TP
+\fIpathName \fBborder\fR \fIoption args\fR
+This command is a voodoo hack to implement border sizing for tables.
+This is normally called through bindings, with the following as valid
+options:
+.RS
+.TP
+\fIpathName \fBborder mark\fR \fIx y\fR ?\fIrow|col\fR?
+Records \fIx\fR and \fIy\fR and the row and/or column border under that
+point in the table window, if any; used in conjunction with later \fBborder
+dragto\fR commands. Typically this command is associated with a mouse
+button press in the widget. If \fIrow\fR or \fIcol\fR is not specified, it
+returns a tuple of both border indices (an empty item means no border).
+Otherwise, just the specified item is returned.
+.TP
+\fIpathName \fBborder dragto\fR \fIx y\fR
+This command computes the difference between its \fIx\fR and \fIy\fR
+arguments and the \fIx\fR and \fIy\fR arguments to the last \fBborder
+mark\fR command for the widget. It then adjusts the previously marked
+border by the difference. This command is typically associated with mouse
+motion events in the widget, to produce the effect of interactive border
+resizing.
+.RE
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR. \fIOption\fR may have any of the values accepted
+by the \fBtable\fR command.
+.TP
+\fIpathName \fBclear\fR \fIoption\fR ?\fIfirst\fR? ?\fIlast\fR?
+This command is a convenience routine to clear certain state information
+managed by the table. \fIfirst\fR and \fIlast\fR represent valid table
+indices. If neither are specified, then the command operates on the
+whole table. The following options are recognized:
+.RS
+.TP
+\fIpathName \fBclear cache\fR ?\fIfirst\fR? ?\fIlast\fR?
+Clears the specified section of the cache, if the table has been
+keeping one.
+.TP
+\fIpathName \fBclear sizes\fR ?\fIfirst\fR? ?\fIlast\fR?
+Clears the specified row and column areas of specific height/width
+dimensions. When just one index is specified, for example \fB2,0\fR,
+that is interpreted as row 2 \fBand\fR column 0.
+.TP
+\fIpathName \fBclear tags\fR ?\fIfirst\fR? ?\fIlast\fR?
+Clears the specified area of tags (all row, column and cell tags).
+.TP
+\fIpathName \fBclear all\fR ?\fIfirst\fR? ?\fIlast\fR?
+Performs all of the above clear functions on the specified area.
+.RE
+.TP
+\fIpathName \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the configuration options of the widget.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the \fBtable\fR
+command.
+.TP
+\fIpathName \fBcurselection\fR ?\fIvalue\fR?
+With no arguments, it returns the sorted indices of the currently selected
+cells. Otherwise it sets all the selected cells to the given value. The
+set has no effect if there is no associated Tcl array or the state is
+disabled.
+.TP
+\fIpathName \fBcurvalue\fR ?\fIvalue\fR?
+If no value is given, the value of the cell being edited (indexed by
+\fBactive\fR) is returned, else it is set to the given value.
+.TP
+\fIpathName \fBdelete\fR \fIoption arg\fR ?\fIarg\fR?
+This command is used to delete various things in a table. It has several
+forms, depending on the \fIoption\fR:
+.RS
+.TP
+\fIpathName \fBdelete active\fR \fIindex\fR ?\fIindex\fR?
+Deletes text from the active cell. If only one index is given, it deletes
+the character after that index, otherwise it deletes from the first index to
+the second. \fIindex\fR can be a number, \fBinsert\fR or \fBend\fR.
+.TP
+\fIpathName \fBdelete cols\fR ?\fIswitches\fR? \fIindex\fR ?\fIcount\fR?
+Deletes \fIcount\fR cols starting at (and including) col \fIindex\fR. The
+\fIindex\fR will be constrained to the limits of the tables. If
+\fIcount\fR is negative, it deletes cols to the left. Otherwise it deletes
+cols to the right. \fIcount\fR defaults to 1 (meaning just the column
+specified). At the moment, spans are
+not adjusted with this action. Optional switches are:
+.RS
+.TP
+\fB\-holddimensions\fR
+Causes the table cols to be unaffected by the deletion (empty cols may
+appear). By default the dimensions are adjusted by \fBcount\fR.
+.TP
+\fB\-holdselection\fR
+Causes the selection to be maintained on the absolute cells values.
+Otherwise, the selection will be cleared..
+.TP
+\fB\-holdtags\fR
+Causes the tags specified by the \fItag\fR method to not move along
+with the data. Also prevents specific widths set by the \fIwidth\fR method
+from being adjusted. By default, these tags are properly adjusted.
+.TP
+\fB\-holdwindows\fR
+Causes the embedded windows created with the \fIwindow\fR method to not
+move along with the data. By default, these windows are properly adjusted.
+.TP
+\fB\-keeptitles\fR
+Prevents title area cells from being changed. Otherwise they are
+treated just like regular cells and will move as specified.
+.TP
+\fB\-\-\fR
+Signifies the end of the switches.
+.RE
+.TP
+\fIpathName \fBdelete rows\fR ?\fIswitches\fR? \fIindex\fR ?\fIcount\fR?
+Deletes \fBcount\fR rows starting at (and including) row \fBindex\fR. If
+\fBcount\fR is negative, it deletes rows going up. Otherwise it deletes
+rows going down. The selection will be cleared. The switches are the same
+as those for column deletion.
+.RE
+.TP
+\fIpathName \fBget\fR \fIfirst\fR ?\fIlast\fR?
+Returns the value of the cells specified by the table indices \fIfirst\fR
+and (optionally) \fIlast\fR in a list.
+.TP
+\fIpathName \fBheight\fR ?\fIrow\fR? ?\fIvalue row value ...\fR?
+If no \fIrow\fR is specified, returns a list describing all rows for which
+a height has been set. If \fBrow\fR is specified with no value, it prints
+out the height of that row in characters (positive number) or pixels
+(negative number). If one or more \fIrow\-value\fR pairs are specified,
+then it sets each row to be that height in lines (positive number) or
+pixels (negative number). If \fIvalue\fR is \fIdefault\fR, then the row
+uses the default height, specified by \fB\-rowheight\fR.
+.TP
+\fIpathName \fBhidden\fR ?\fIindex\fR? ?\fIindex ...\fR?
+When called without args, it returns all the \fIhidden\fR cells (those
+cells covered by a spanning cell). If one index is specified, it returns
+the spanning cell covering that index, if any. If multiple indices are
+specified, it returns 1 if all indices are hidden cells, 0 otherwise.
+.TP
+\fIpathName \fBicursor\fR ?\fIarg\fR?
+With no arguments, prints out the location of the insertion cursor in the
+active cell. With one argument, sets the cursor to that point in the
+string. 0 is before the first character, you can also use \fBinsert\fR or
+\fBend\fR for the current insertion point or the end of the text. If
+there is no active cell, or the cell or table is disabled, this will
+return -1.
+.TP
+\fIpathName \fBindex\fR \fIindex\fR ?\fIrow|col\fR?
+Returns the integer cell coordinate that corresponds to \fIindex\fR in the
+form row,col. If \fBrow\fR or \fBcol\fR is specified, then only the row or
+column index is returned.
+.TP
+\fIpathName \fBinsert\fR \fIoption arg arg\fR
+This command is used to into various things into a table. It has several
+forms, depending on the \fIoption\fR:
+.RS
+.TP
+\fIpathName \fBinsert active\fR \fIindex value\fR
+The \fIvalue\fR is a text string which is inserted at the \fIindex\fR
+position of the active cell. The cursor is then positioned after the
+new text. \fIindex\fR can be a number, \fBinsert\fR or \fBend\fR.
+.TP
+\fIpathName \fBinsert cols\fR ?\fIswitches\fR? \fIindex\fR ?\fIcount\fR?
+Inserts \fBcount\fR cols starting at col \fBindex\fR. If \fBcount\fR is
+negative, it inserts before the specified col. Otherwise it inserts after
+the specified col. The selection will be cleared. The switches are the
+same as those for column deletion.
+.TP
+\fIpathName \fBinsert rows\fR ?\fIswitches\fR? \fIindex\fR ?\fIcount\fR?
+Inserts \fBcount\fR rows starting at row \fBindex\fR. If \fBcount\fR is
+negative, it inserts before the specified row. Otherwise it inserts after
+the specified row. The selection will be cleared. The switches are the
+same as those for column deletion.
+.RE
+.TP
+\fIpathName \fBreread\fR
+Rereads the old contents of the cell back into the editing buffer. Useful
+for a key binding when is pressed to abort the edit (a default
+binding).
+.TP
+\fIpathName \fBscan\fR \fIoption args\fR
+This command is used to implement scanning on tables. It has
+two forms, depending on \fIoption\fR:
+.RS
+.TP
+\fIpathName \fBscan mark\fR \fIx y\fR
+Records \fIx\fR and \fIy\fR and the current view in the table
+window; used in conjunction with later \fBscan dragto\fR commands.
+Typically this command is associated with a mouse button press in
+the widget. It returns an empty string.
+.TP
+\fIpathName \fBscan dragto\fR \fIx y\fR.
+This command computes the difference between its \fIx\fR and \fIy\fR
+arguments and the \fIx\fR and \fIy\fR arguments to the last \fBscan mark\fR
+command for the widget. It then adjusts the view by 5 times the difference
+in coordinates. This command is typically associated with mouse motion
+events in the widget, to produce the effect of dragging the list at high
+speed through the window. The return value is an empty string.
+.RE
+.TP
+\fIpathName \fBsee\fR \fIindex\fR
+Adjust the view in the table so that the cell given by \fIindex\fR is
+positioned as the cell one off from top left (excluding title rows and
+columns) if the cell is not currently visible on the screen. The actual
+cell may be different to keep the screen full.
+.TP
+\fIpathName \fBselection\fR \fIoption arg\fR
+This command is used to adjust the selection within a table. It
+has several forms, depending on \fIoption\fR:
+.RS
+.TP
+\fIpathName \fBselection anchor\fR \fIindex\fR
+Sets the selection anchor to the cell given by \fIindex\fR. The selection
+anchor is the end of the selection that is fixed while dragging out a
+selection with the mouse. The index \fBanchor\fR may be used to refer to
+the anchor cell.
+.TP
+\fIpathName \fBselection clear\fR \fIfirst \fR?\fIlast\fR?
+If any of the cells between \fIfirst\fR and \fIlast\fR (inclusive) are
+selected, they are deselected. The selection state is not changed for cells
+outside this range. \fIfirst\fR may be specified as \fBall\fR to remove
+the selection from all cells.
+.TP
+\fIpathName \fBselection includes\fR \fIindex\fR
+Returns 1 if the cell indicated by \fIindex\fR is currently
+selected, 0 if it isn't.
+.TP
+\fIpathName \fBselection set\fR \fIfirst\fR ?\fIlast\fR?
+Selects all of the cells in the range between \fIfirst\fR and \fIlast\fR,
+inclusive, without affecting the selection state of cells outside that
+range.
+.RE
+.TP
+\fIpathName \fBset\fR ?\fIrow|col\fR? \fIindex\fR ?\fIvalue\fR? ?\fIindex value ...\fR?
+Sets the specified index to the associated value. Table validation will
+not be triggered via this method. If \fBrow\fR or \fBcol\fR precedes the
+list of index/value pairs, then the value is assumed to be a Tcl list whose
+values will be split and set into the subsequent columns (if \fBrow\fR is
+specified) or rows (for \fBcol\fR). For example, \fBset row 2,3
+{2,3 2,4 2,5}\fR will set 3 cells, from 2,3 to 2,5. The setting of cells
+is silently bounded by the known table dimensions.
+.TP
+\fIpathName \fBspans\fR ?\fIindex\fR? ?\fIrows,cols index rows,cols ...\fR?
+This command is used to manipulate row/col spans. When called with no
+arguments, all known spans are returned as a list of tuples of the form
+{index span}. When called with only the \fIindex\fR, the span for that
+\fIindex\fR only is returned, if any. Otherwise an even number of
+\fIindex rows,cols\fR pairs are used to set spans. A span starts at the
+\fIindex\fR and continues for the specified number of rows and cols.
+Negative spans are not supported. A span of 0,0 unsets any span on that
+cell. See EXAMPLES for more info.
+.TP
+\fIpathName \fBtag\fR option ?\fIarg arg ...\fR?
+This command is used to manipulate tags. The exact behavior of the command
+depends on the \fIoption\fR argument that follows the \fBtag\fR argument.
+\fIcget\fR, \fIcell\fR, and \fIrow|col\fR complain about unknown tag names.
+The following forms of the command are currently supported:
+.RS
+.TP
+\fIpathName \fBtag cell\fR \fItagName ?index ...?\fR
+With no arguments, prints out the list of cells that use the \fItag\fR.
+Otherwise it sets the specified cells to use the named tag, replacing any
+tag that may have been set using this method before. If \fItagName\fR is
+{}, the cells are reset to the default \fItag\fR. Tags added during
+\-*tagcommand evaluation do not register here. If \fItagName\fR does
+not exist, it will be created with the default options.
+.TP
+\fIpathName \fBtag cget\fR \fItagName option\fR
+This command returns the current value of the option named \fIoption\fR
+associated with the tag given by \fItagName\fR. \fIOption\fR may have any
+of the values accepted by the \fBtag configure\fR widget command.
+.TP
+\fIpathName \fBtag col\fR \fItagName ?col ...?\fR
+With no arguments, prints out the list of cols that use the \fItag\fR.
+Otherwise it sets the specified columns to use the named tag, replacing any
+tag that may have been set using this method before. If \fItagName\fR is
+{}, the cols are reset to the default \fItag\fR. Tags added during
+\-coltagcommand evaluation do not register here. If \fItagName\fR does
+not exist, it will be created with the default options.
+.TP
+\fIpathName \fBtag configure \fItagName\fR ?\fIoption\fR? ?\fIvalue\fR? ?\fIoption value ...\fR?
+This command is similar to the \fBconfigure\fR widget command except that
+it modifies options associated with the tag given by \fItagName\fR instead
+of modifying options for the overall table widget. If no \fIoption\fR is
+specified, the command returns a list describing all of the available
+options for \fItagName\fR (see \fBTk_ConfigureInfo\fR for information on
+the format of this list). If \fIoption\fR is specified with no
+\fIvalue\fR, then the command returns a list describing the one named
+option (this list will be identical to the corresponding sublist of the
+value returned if no \fIoption\fR is specified). If one or more
+\fIoption\-value\fR pairs are specified, then the command modifies the
+given option(s) to have the given value(s) in \fItagName\fR; in this case
+the command returns an empty string.
+See TAGS above for details on the options available for tags.
+.TP
+\fIpathName \fBtag delete\fR \fItagName\fR
+Deletes a tag. No error if the tag does not exist.
+.TP
+\fIpathName \fBtag exists\fR \fItagName\fR
+Returns 1 if the named tag exists, 0 otherwise.
+.TP
+\fIpathName \fBtag includes\fR \fItagName index\fR
+Returns 1 if the specified index has the named tag, 0 otherwise.
+.TP
+\fIpathName \fBtag lower\fR \fItagName\fR ?\fIbelowThis\fR?
+Lower the priority of the named tag. If \fIbelowThis\fR is not specified,
+then the tag's priority is lowered to the bottom, otherwise it is lowered
+to one below \fIbelowThis\fR.
+.TP
+\fIpathName \fBtag names\fR ?\fIpattern\fR?
+If no pattern is specified, shows the names of all defined tags.
+Otherwise the \fIpattern\fR is used as a glob pattern to show only
+tags matching that pattern. Tag names are returned in priority order
+(highest priority tag first).
+.TP
+\fIpathName \fBtag raise\fR \fItagName\fR ?\fIaboveThis\fR?
+Raise the priority of the named tag. If \fIaboveThis\fR is not specified,
+then the tag's priority is raised to the top, otherwise it is raised to
+one above \fIaboveThis\fR.
+.TP
+\fIpathName \fBtag row\fR \fItagName\fR ?\fIrow ...\fR?
+With no arguments, prints out the list of rows that use the \fItag\fR.
+Otherwise it sets the specified rows to use the named tag, replacing any
+tag that may have been set using this method before. If \fItagName\fR is
+{}, the rows are reset to use the default tag. Tags added during
+\-rowtagcommand evaluation do not register here. If \fItagName\fR does
+not exist, it will be created with the default options.
+.RE
+.TP
+\fIpathName \fBvalidate\fR \fIindex\fR
+Explicitly validates the specified index based on the current
+\fB\-validatecommand\fR and returns 0 or 1 based on whether the cell was
+validated.
+.TP
+\fIpathName \fBwidth\fR ?\fIcol\fR? ?\fIvalue col value ...\fR?
+If no \fIcol\fR is specified, returns a list describing all cols for which
+a width has been set. If \fBcol\fR is specified with no value, it prints
+out the width of that col in characters (positive number) or pixels
+(negative number). If one or more \fIcol\-value\fR pairs are specified,
+then it sets each col to be that width in characters (positive number) or
+pixels (negative number). If \fIvalue\fR is \fIdefault\fR, then the col
+uses the default width, specified by \fB\-colwidth\fR.
+.TP
+\fIpathName \fBwindow\fR option ?\fIarg arg ...\fR?
+This command is used to manipulate embedded windows. The exact behavior of
+the command depends on the \fIoption\fR argument that follows the
+\fBwindow\fR argument. The following forms of the command are currently
+supported:
+.RS
+.TP
+\fIpathName \fBwindow cget\fR \fIindex option\fR
+This command returns the current value of the option named \fIoption\fR
+associated with the window given by \fIindex\fR. \fIOption\fR may have any
+of the values accepted by the \fBwindow configure\fR widget command.
+.TP
+\fIpathName \fBwindow configure \fIindex\fR ?\fIoption\fR? ?\fIvalue\fR? ?\fIoption value ...\fR?
+This command is similar to the \fBconfigure\fR widget command except that
+it modifies options associated with the embedded window given by
+\fIindex\fR instead of modifying options for the overall table widget. If
+no \fIoption\fR is specified, the command returns a list describing all of
+the available options for \fIindex\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified with
+no \fIvalue\fR, then the command returns a list describing the one named
+option (this list will be identical to the corresponding sublist of the
+value returned if no \fIoption\fR is specified). If one or more
+\fIoption\-value\fR pairs are specified, then the command modifies the
+given option(s) to have the given value(s) in \fIindex\fR; in this case
+the command returns an empty string.
+See EMBEDDED WINDOWS above for details on the options available for windows.
+.TP
+\fIpathName \fBwindow delete\fR \fIindex\fR ?\fIindex ...\fR?
+Deletes an embedded window from the table. The associated window will
+also be deleted.
+.TP
+\fIpathName \fBwindow move\fR \fIindexFrom indexTo\fR
+Moves an embedded window from one cell to another. If a window already
+exists in the target cell, it will be deleted.
+.TP
+\fIpathName \fBwindow names\fR ?\fIpattern\fR?
+If no pattern is specified, shows the cells of all embedded windows.
+Otherwise the \fIpattern\fR is used as a glob pattern to show only
+cells matching that pattern.
+.RE
+.TP
+\fIpathName \fBxview \fIargs\fR
+This command is used to query and change the horizontal position of the
+information in the widget's window. It can take any of the following
+forms:
+.RS
+.TP
+\fIpathName \fBxview\fR
+Returns a list containing two elements.
+Each element is a real fraction between 0 and 1; together they describe
+the horizontal span that is visible in the window.
+For example, if the first element is .2 and the second element is .6,
+20% of the table's text is off\-screen to the left, the middle 40% is visible
+in the window, and 40% of the text is off\-screen to the right.
+These are the same values passed to scrollbars via the \fB\-xscrollcommand\fR
+option.
+.TP
+\fIpathName \fBxview\fR \fIindex\fR
+Adjusts the view in the window so that the column given by
+\fIindex\fR is displayed at the left edge of the window.
+.TP
+\fIpathName \fBxview moveto\fI fraction\fR
+Adjusts the view in the window so that \fIfraction\fR of the
+total width of the table text is off\-screen to the left.
+\fIfraction\fR must be a fraction between 0 and 1.
+.TP
+\fIpathName \fBxview scroll \fInumber what\fR
+This command shifts the view in the window left or right according to
+\fInumber\fR and \fIwhat\fR.
+\fINumber\fR must be an integer.
+\fIWhat\fR must be either \fBunits\fR or \fBpages\fR or an abbreviation
+of one of these.
+If \fIwhat\fR is \fBunits\fR, the view adjusts left or right by
+\fInumber\fR cells on the display; if it is \fBpages\fR then the view
+adjusts by \fInumber\fR screenfuls.
+If \fInumber\fR is negative then cells farther to the left
+become visible; if it is positive then cells farther to the right
+become visible.
+.RE
+.TP
+\fIpathName \fByview \fI?args\fR?
+This command is used to query and change the vertical position of the
+text in the widget's window. It can take any of the following forms:
+.RS
+.TP
+\fIpathName \fByview\fR
+Returns a list containing two elements, both of which are real fractions
+between 0 and 1. The first element gives the position of the table element
+at the top of the window, relative to the table as a whole (0.5 means it is
+halfway through the table, for example). The second element gives the
+position of the table element just after the last one in the window,
+relative to the table as a whole. These are the same values passed to
+scrollbars via the \fB\-yscrollcommand\fR option.
+.TP
+\fIpathName \fByview\fR \fIindex\fR
+Adjusts the view in the window so that the row given by
+\fIindex\fR is displayed at the top of the window.
+.TP
+\fIpathName \fByview moveto\fI fraction\fR
+Adjusts the view in the window so that the element given by \fIfraction\fR
+appears at the top of the window.
+\fIFraction\fR is a fraction between 0 and 1; 0 indicates the first
+element in the table, 0.33 indicates the element one\-third the
+way through the table, and so on.
+.TP
+\fIpathName \fByview scroll \fInumber what\fR
+This command adjusts the view in the window up or down according to
+\fInumber\fR and \fIwhat\fR. \fINumber\fR must be an integer. \fIWhat\fR
+must be either \fBunits\fR or \fBpages\fR. If \fIwhat\fR is \fBunits\fR,
+the view adjusts up or down by \fInumber\fR cells; if it is \fBpages\fR then
+the view adjusts by \fInumber\fR screenfuls. If \fInumber\fR is negative
+then earlier elements become visible; if it is positive then later elements
+become visible.
+.RE
+
+.SH "DEFAULT BINDINGS"
+.PP
+The initialization creates class bindings that give the
+following default behaviour:
+.IP [1]
+Clicking Button\-1 in a cell activates that cell. Clicking
+into an already active cell moves the insertion cursor to the
+character nearest the mouse.
+.IP [2]
+Moving the mouse while Button\-1 is pressed will stroke out a selection area.
+Exiting while Button\-1 is pressed causing scanning to occur on the table
+along with selection.
+.IP [3]
+Moving the mouse while Button\-2 is pressed causes scanning to
+occur without any selection.
+.IP [4]
+Home moves the table to have the origin in view.
+.IP [5]
+End moves the table to have the \fBend\fR cell in view.
+.IP [6]
+Control\-Home moves the table to the origin and activates that cell.
+.IP [7]
+Control\-End moves the table to the end and activates that cell.
+.IP [8]
+Shift\-Control\-Home extends the selection to the origin.
+.IP [9]
+Shift\-Control\-End extends the selection to the end.
+.IP [10]
+The left, right, up and down arrows move the active cell.
+.IP [11]
+Shift\- extends the selection in that direction.
+.IP [12]
+Control\-leftarrow and Control\-rightarrow move the insertion
+cursor within the cell.
+.IP [13]
+Control\-slash selects all the cells.
+.IP [14]
+Control\-backslash clears selection from all the cells.
+.IP [15]
+Backspace deletes the character before the insertion cursor
+in the active cell.
+.IP [16]
+Delete deletes the character after the insertion cursor
+in the active cell.
+.IP [17]
+Escape rereads the value of the active cell from the specified data source,
+discarding any edits that have may been performed on the cell.
+.IP [18]
+Control\-a moves the insertion cursor to the beginning of the active cell.
+.IP [19]
+Control\-e moves the insertion cursor to the end of the active cell.
+.IP [20]
+Control\-minus and Control\-equals decrease and increase the
+width of the column with the active cell in it.
+.IP [21]
+Moving the mouse while Button\-3 (the right button on Windows) is pressed
+while you are over a border will cause interactive resizing of that row
+and/or column to occur, based on the value of \fB\-resizeborders\fR.
+.PP
+Some bindings may have slightly different behavior dependent on the
+\fB\-selectionmode\fR of the widget.
+.PP
+If the widget is disabled using the \fB\-state\fR option, then its
+view can still be adjusted and cells can still be selected,
+but no insertion cursor will be displayed and no cell modifications will
+take place.
+.PP
+The behavior of tables can be changed by defining new bindings for
+individual widgets or by redefining the class bindings. The default
+bindings are either compiled in or read from a file expected to
+correspond to: "[lindex $tcl_pkgPath 0]/Tktable/tkTable.tcl".
+
+.SH "PERFORMANCE ISSUES"
+.PP
+The number of rows and columns or a table widget should not significantly
+affect the speed of redraw. Recalculation and redraw of table parameters
+and cells is restricted as much as possible.
+.PP
+The display cell with the insert cursor is redrawn each time the cursor
+blinks, which causes a steady stream of graphics traffic. Set the
+\fB\-insertofftime\fR option to 0 avoid this. The use of a \fB\-command\fR
+with the table without a cache can cause significant slow\-down, as the
+command is called once for each request of a cell value.
+
+
+.SH EXAMPLES
+.PP
+Set the topleft title area to be one spanning cell. This overestimates
+both row and column span by one, but the command does all the constraining
+for us.
+.CS
+$table span [$table cget -roworigin],[$table cget -colorigin] [$table cget -titlerows],[$table cget -titlecols]
+.CE
+Force a table window refresh (useful for the slight chance that a bug
+in the table is not causing proper refresh):
+.CS
+$table configure -padx [$table cget -padx]
+.CE
+
+.SH KEYWORDS
+table, widget, extension
diff --git a/tktable/generic/tkAppInit.c b/tktable/generic/tkAppInit.c
new file mode 100644
index 0000000..bc4fb61
--- /dev/null
+++ b/tktable/generic/tkAppInit.c
@@ -0,0 +1,132 @@
+/*
+ * tkAppInit.c --
+ *
+ * Provides a default version of the Tcl_AppInit procedure for
+ * use in wish and similar Tk-based applications.
+ *
+ * Copyright (c) 1993 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkAppInit.c 1.24 98/01/13 17:21:40
+ */
+
+#include "tk.h"
+#include "locale.h"
+
+/*
+ * The following variable is a special hack that is needed in order for
+ * Sun shared libraries to be used for Tcl.
+ */
+
+extern int matherr();
+int *tclDummyMathPtr = (int *) matherr;
+
+EXTERN int Tktable_Init _ANSI_ARGS_((Tcl_Interp *interp));
+#ifdef TK_TEST
+EXTERN int Tcltest_Init _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN int Tktest_Init _ANSI_ARGS_((Tcl_Interp *interp));
+#endif /* TK_TEST */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * main --
+ *
+ * This is the main program for the application.
+ *
+ * Results:
+ * None: Tk_Main never returns here, so this procedure never
+ * returns either.
+ *
+ * Side effects:
+ * Whatever the application does.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+main(argc, argv)
+ int argc; /* Number of command-line arguments. */
+ char **argv; /* Values of command-line arguments. */
+{
+ Tk_Main(argc, argv, Tcl_AppInit);
+ return 0; /* Needed only to prevent compiler warning. */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AppInit --
+ *
+ * This procedure performs application-specific initialization.
+ * Most applications, especially those that incorporate additional
+ * packages, will have their own version of this procedure.
+ *
+ * Results:
+ * Returns a standard Tcl completion code, and leaves an error
+ * message in interp->result if an error occurs.
+ *
+ * Side effects:
+ * Depends on the startup script.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_AppInit(interp)
+ Tcl_Interp *interp; /* Interpreter for application. */
+{
+ if (Tcl_Init(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ if (Tk_Init(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ Tcl_StaticPackage(interp, "Tk", Tk_Init, (Tcl_PackageInitProc *) NULL);
+#ifdef TK_TEST
+ if (Tcltest_Init(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init,
+ (Tcl_PackageInitProc *) NULL);
+ if (Tktest_Init(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ Tcl_StaticPackage(interp, "Tktest", Tktest_Init,
+ (Tcl_PackageInitProc *) NULL);
+#endif /* TK_TEST */
+
+
+ /*
+ * Call the init procedures for included packages. Each call should
+ * look like this:
+ *
+ * if (Mod_Init(interp) == TCL_ERROR) {
+ * return TCL_ERROR;
+ * }
+ *
+ * where "Mod" is the name of the module.
+ */
+ if (Tktable_Init(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ Tcl_StaticPackage(interp, "Tktable", Tktable_Init, Tktable_SafeInit);
+
+ /*
+ * Call Tcl_CreateCommand for application-specific commands, if
+ * they weren't already created by the init procedures called above.
+ */
+
+ /*
+ * Specify a user-specific startup file to invoke if the application
+ * is run interactively. Typically the startup file is "~/.apprc"
+ * where "app" is the name of the application. If this line is deleted
+ * then no user-specific startup file will be run under any conditions.
+ */
+
+ Tcl_SetVar(interp, "tcl_rcFileName", "~/.wishrc", TCL_GLOBAL_ONLY);
+ return TCL_OK;
+}
diff --git a/tktable/generic/tkTable.c b/tktable/generic/tkTable.c
new file mode 100644
index 0000000..9392b8f
--- /dev/null
+++ b/tktable/generic/tkTable.c
@@ -0,0 +1,4090 @@
+/*
+ * tkTable.c --
+ *
+ * This module implements table widgets for the Tk
+ * toolkit. An table displays a 2D array of strings
+ * and allows the strings to be edited.
+ *
+ * Based on Tk3 table widget written by Roland King
+ *
+ * Updates 1996 by:
+ * Jeffrey Hobbs jeff at hobbs org
+ * John Ellson ellson@lucent.com
+ * Peter Bruecker peter@bj-ig.de
+ * Tom Moore tmoore@spatial.ca
+ * Sebastian Wangnick wangnick@orthogon.de
+ *
+ * Copyright (c) 1997-2002 Jeffrey Hobbs
+ *
+ * See the file "license.txt" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id: tkTable.c,v 1.34 2008/11/14 23:43:35 hobbs Exp $
+ */
+
+#include "tkTable.h"
+
+#ifdef DEBUG
+#include "dprint.h"
+#endif
+
+static char ** StringifyObjects(int objc, Tcl_Obj *CONST objv[]);
+
+static int Tk_TableObjCmd(ClientData clientData, Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[]);
+
+static int TableWidgetObjCmd(ClientData clientData, Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[]);
+static int TableConfigure(Tcl_Interp *interp, Table *tablePtr,
+ int objc, Tcl_Obj *CONST objv[],
+ int flags, int forceUpdate);
+#ifdef HAVE_TCL84
+static void TableWorldChanged(ClientData instanceData);
+#endif
+static void TableDestroy(ClientData clientdata);
+static void TableEventProc(ClientData clientData, XEvent *eventPtr);
+static void TableCmdDeletedProc(ClientData clientData);
+
+static void TableRedrawHighlight(Table *tablePtr);
+static void TableGetGc(Display *display, Drawable d,
+ TableTag *tagPtr, GC *tagGc);
+
+static void TableDisplay(ClientData clientdata);
+static void TableFlashEvent(ClientData clientdata);
+static char * TableVarProc(ClientData clientData, Tcl_Interp *interp,
+ char *name, char *index, int flags);
+static void TableCursorEvent(ClientData clientData);
+static int TableFetchSelection(ClientData clientData,
+ int offset, char *buffer, int maxBytes);
+static Tk_RestrictAction TableRestrictProc(ClientData arg, XEvent *eventPtr);
+
+/*
+ * The following tables define the widget commands (and sub-
+ * commands) and map the indexes into the string tables into
+ * enumerated types used to dispatch the widget command.
+ */
+
+static CONST84 char *selCmdNames[] = {
+ "anchor", "clear", "includes", "present", "set", (char *)NULL
+};
+enum selCommand {
+ CMD_SEL_ANCHOR, CMD_SEL_CLEAR, CMD_SEL_INCLUDES, CMD_SEL_PRESENT,
+ CMD_SEL_SET
+};
+
+static CONST84 char *commandNames[] = {
+ "activate", "bbox", "border", "cget", "clear", "configure",
+ "curselection", "curvalue", "delete", "get", "height",
+ "hidden", "icursor", "index", "insert",
+#ifdef POSTSCRIPT
+ "postscript",
+#endif
+ "reread", "scan", "see", "selection", "set",
+ "spans", "tag", "validate", "version", "window", "width",
+ "xview", "yview", (char *)NULL
+};
+enum command {
+ CMD_ACTIVATE, CMD_BBOX, CMD_BORDER, CMD_CGET, CMD_CLEAR, CMD_CONFIGURE,
+ CMD_CURSEL, CMD_CURVALUE, CMD_DELETE, CMD_GET, CMD_HEIGHT,
+ CMD_HIDDEN, CMD_ICURSOR, CMD_INDEX, CMD_INSERT,
+#ifdef POSTSCRIPT
+ CMD_POSTSCRIPT,
+#endif
+ CMD_REREAD, CMD_SCAN, CMD_SEE, CMD_SELECTION, CMD_SET,
+ CMD_SPANS, CMD_TAG, CMD_VALIDATE, CMD_VERSION, CMD_WINDOW, CMD_WIDTH,
+ CMD_XVIEW, CMD_YVIEW
+};
+
+/* -selecttype selection type options */
+static Cmd_Struct sel_vals[]= {
+ {"row", SEL_ROW},
+ {"col", SEL_COL},
+ {"both", SEL_BOTH},
+ {"cell", SEL_CELL},
+ {"", 0 }
+};
+
+/* -resizeborders options */
+static Cmd_Struct resize_vals[]= {
+ {"row", SEL_ROW}, /* allow rows to be dragged */
+ {"col", SEL_COL}, /* allow cols to be dragged */
+ {"both", SEL_ROW|SEL_COL}, /* allow either to be dragged */
+ {"none", SEL_NONE}, /* allow nothing to be dragged */
+ {"", 0 }
+};
+
+/* drawmode values */
+/* The display redraws with a pixmap using TK function calls */
+#define DRAW_MODE_SLOW (1<<0)
+/* The redisplay is direct to the screen, but TK function calls are still
+ * used to give correct 3-d border appearance and thus remain compatible
+ * with other TK apps */
+#define DRAW_MODE_TK_COMPAT (1<<1)
+/* the redisplay goes straight to the screen and the 3d borders are rendered
+ * with a single pixel wide line only. It cheats and uses the internal
+ * border structure to do the borders */
+#define DRAW_MODE_FAST (1<<2)
+#define DRAW_MODE_SINGLE (1<<3)
+
+static Cmd_Struct drawmode_vals[] = {
+ {"fast", DRAW_MODE_FAST},
+ {"compatible", DRAW_MODE_TK_COMPAT},
+ {"slow", DRAW_MODE_SLOW},
+ {"single", DRAW_MODE_SINGLE},
+ {"", 0}
+};
+
+/* stretchmode values */
+#define STRETCH_MODE_NONE (1<<0) /* No additional pixels will be
+ added to rows or cols */
+#define STRETCH_MODE_UNSET (1<<1) /* All default rows or columns will
+ be stretched to fill the screen */
+#define STRETCH_MODE_ALL (1<<2) /* All rows/columns will be padded
+ to fill the window */
+#define STRETCH_MODE_LAST (1<<3) /* Stretch last elememt to fill
+ window */
+#define STRETCH_MODE_FILL (1<<4) /* More ROWS in Window */
+
+static Cmd_Struct stretch_vals[] = {
+ {"none", STRETCH_MODE_NONE},
+ {"unset", STRETCH_MODE_UNSET},
+ {"all", STRETCH_MODE_ALL},
+ {"last", STRETCH_MODE_LAST},
+ {"fill", STRETCH_MODE_FILL},
+ {"", 0}
+};
+
+static Cmd_Struct state_vals[]= {
+ {"normal", STATE_NORMAL},
+ {"disabled", STATE_DISABLED},
+ {"", 0 }
+};
+
+/* The widget configuration table */
+static Tk_CustomOption drawOpt = { Cmd_OptionSet, Cmd_OptionGet,
+ (ClientData)(&drawmode_vals) };
+static Tk_CustomOption resizeTypeOpt = { Cmd_OptionSet, Cmd_OptionGet,
+ (ClientData)(&resize_vals) };
+static Tk_CustomOption stretchOpt = { Cmd_OptionSet, Cmd_OptionGet,
+ (ClientData)(&stretch_vals) };
+static Tk_CustomOption selTypeOpt = { Cmd_OptionSet, Cmd_OptionGet,
+ (ClientData)(&sel_vals) };
+static Tk_CustomOption stateTypeOpt = { Cmd_OptionSet, Cmd_OptionGet,
+ (ClientData)(&state_vals) };
+static Tk_CustomOption bdOpt = { TableOptionBdSet, TableOptionBdGet,
+ (ClientData) BD_TABLE };
+
+Tk_ConfigSpec tableSpecs[] = {
+ {TK_CONFIG_ANCHOR, "-anchor", "anchor", "Anchor", "center",
+ Tk_Offset(Table, defaultTag.anchor), 0},
+ {TK_CONFIG_BOOLEAN, "-autoclear", "autoClear", "AutoClear", "0",
+ Tk_Offset(Table, autoClear), 0},
+ {TK_CONFIG_BORDER, "-background", "background", "Background", NORMAL_BG,
+ Tk_Offset(Table, defaultTag.bg), 0},
+ {TK_CONFIG_SYNONYM, "-bd", "borderWidth", (char *)NULL, (char *)NULL, 0, 0},
+ {TK_CONFIG_SYNONYM, "-bg", "background", (char *)NULL, (char *)NULL, 0, 0},
+ {TK_CONFIG_CURSOR, "-bordercursor", "borderCursor", "Cursor", "crosshair",
+ Tk_Offset(Table, bdcursor), TK_CONFIG_NULL_OK },
+ {TK_CONFIG_CUSTOM, "-borderwidth", "borderWidth", "BorderWidth", "1",
+ Tk_Offset(Table, defaultTag), TK_CONFIG_NULL_OK, &bdOpt },
+ {TK_CONFIG_STRING, "-browsecommand", "browseCommand", "BrowseCommand", "",
+ Tk_Offset(Table, browseCmd), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_SYNONYM, "-browsecmd", "browseCommand", (char *)NULL,
+ (char *)NULL, 0, TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BOOLEAN, "-cache", "cache", "Cache", "0",
+ Tk_Offset(Table, caching), 0},
+ {TK_CONFIG_INT, "-colorigin", "colOrigin", "Origin", "0",
+ Tk_Offset(Table, colOffset), 0},
+ {TK_CONFIG_INT, "-cols", "cols", "Cols", "10",
+ Tk_Offset(Table, cols), 0},
+ {TK_CONFIG_STRING, "-colseparator", "colSeparator", "Separator", NULL,
+ Tk_Offset(Table, colSep), TK_CONFIG_NULL_OK },
+ {TK_CONFIG_CUSTOM, "-colstretchmode", "colStretch", "StretchMode", "none",
+ Tk_Offset (Table, colStretch), 0 , &stretchOpt },
+ {TK_CONFIG_STRING, "-coltagcommand", "colTagCommand", "TagCommand", NULL,
+ Tk_Offset(Table, colTagCmd), TK_CONFIG_NULL_OK },
+ {TK_CONFIG_INT, "-colwidth", "colWidth", "ColWidth", "10",
+ Tk_Offset(Table, defColWidth), 0},
+ {TK_CONFIG_STRING, "-command", "command", "Command", "",
+ Tk_Offset(Table, command), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_ACTIVE_CURSOR, "-cursor", "cursor", "Cursor", "xterm",
+ Tk_Offset(Table, cursor), TK_CONFIG_NULL_OK },
+ {TK_CONFIG_CUSTOM, "-drawmode", "drawMode", "DrawMode", "compatible",
+ Tk_Offset(Table, drawMode), 0, &drawOpt },
+ {TK_CONFIG_STRING, "-ellipsis", "ellipsis", "Ellipsis", "",
+ Tk_Offset(Table, defaultTag.ellipsis), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BOOLEAN, "-exportselection", "exportSelection",
+ "ExportSelection", "1", Tk_Offset(Table, exportSelection), 0},
+ {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *)NULL, (char *)NULL, 0, 0},
+ {TK_CONFIG_BOOLEAN, "-flashmode", "flashMode", "FlashMode", "0",
+ Tk_Offset(Table, flashMode), 0},
+ {TK_CONFIG_INT, "-flashtime", "flashTime", "FlashTime", "2",
+ Tk_Offset(Table, flashTime), 0},
+ {TK_CONFIG_FONT, "-font", "font", "Font", DEF_TABLE_FONT,
+ Tk_Offset(Table, defaultTag.tkfont), 0},
+ {TK_CONFIG_BORDER, "-foreground", "foreground", "Foreground", "black",
+ Tk_Offset(Table, defaultTag.fg), 0},
+#ifdef PROCS
+ {TK_CONFIG_BOOLEAN, "-hasprocs", "hasProcs", "hasProcs", "0",
+ Tk_Offset(Table, hasProcs), 0},
+#endif
+ {TK_CONFIG_INT, "-height", "height", "Height", "0",
+ Tk_Offset(Table, maxReqRows), 0},
+ {TK_CONFIG_COLOR, "-highlightbackground", "highlightBackground",
+ "HighlightBackground", NORMAL_BG, Tk_Offset(Table, highlightBgColorPtr), 0},
+ {TK_CONFIG_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
+ HIGHLIGHT, Tk_Offset(Table, highlightColorPtr), 0},
+ {TK_CONFIG_PIXELS, "-highlightthickness", "highlightThickness",
+ "HighlightThickness", "2", Tk_Offset(Table, highlightWidth), 0},
+ {TK_CONFIG_BORDER, "-insertbackground", "insertBackground", "Foreground",
+ "Black", Tk_Offset(Table, insertBg), 0},
+ {TK_CONFIG_PIXELS, "-insertborderwidth", "insertBorderWidth", "BorderWidth",
+ "0", Tk_Offset(Table, insertBorderWidth), TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_PIXELS, "-insertborderwidth", "insertBorderWidth", "BorderWidth",
+ "0", Tk_Offset(Table, insertBorderWidth), TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_INT, "-insertofftime", "insertOffTime", "OffTime", "300",
+ Tk_Offset(Table, insertOffTime), 0},
+ {TK_CONFIG_INT, "-insertontime", "insertOnTime", "OnTime", "600",
+ Tk_Offset(Table, insertOnTime), 0},
+ {TK_CONFIG_PIXELS, "-insertwidth", "insertWidth", "InsertWidth", "2",
+ Tk_Offset(Table, insertWidth), 0},
+ {TK_CONFIG_BOOLEAN, "-invertselected", "invertSelected", "InvertSelected",
+ "0", Tk_Offset(Table, invertSelected), 0},
+ {TK_CONFIG_PIXELS, "-ipadx", "ipadX", "Pad", "0",
+ Tk_Offset(Table, ipadX), 0},
+ {TK_CONFIG_PIXELS, "-ipady", "ipadY", "Pad", "0",
+ Tk_Offset(Table, ipadY), 0},
+ {TK_CONFIG_JUSTIFY, "-justify", "justify", "Justify", "left",
+ Tk_Offset(Table, defaultTag.justify), 0 },
+ {TK_CONFIG_PIXELS, "-maxheight", "maxHeight", "MaxHeight", "600",
+ Tk_Offset(Table, maxReqHeight), 0},
+ {TK_CONFIG_PIXELS, "-maxwidth", "maxWidth", "MaxWidth", "800",
+ Tk_Offset(Table, maxReqWidth), 0},
+ {TK_CONFIG_BOOLEAN, "-multiline", "multiline", "Multiline", "1",
+ Tk_Offset(Table, defaultTag.multiline), 0},
+ {TK_CONFIG_PIXELS, "-padx", "padX", "Pad", "0", Tk_Offset(Table, padX), 0},
+ {TK_CONFIG_PIXELS, "-pady", "padY", "Pad", "0", Tk_Offset(Table, padY), 0},
+ {TK_CONFIG_RELIEF, "-relief", "relief", "Relief", "sunken",
+ Tk_Offset(Table, defaultTag.relief), 0},
+ {TK_CONFIG_CUSTOM, "-resizeborders", "resizeBorders", "ResizeBorders",
+ "both", Tk_Offset(Table, resize), 0, &resizeTypeOpt },
+ {TK_CONFIG_INT, "-rowheight", "rowHeight", "RowHeight", "1",
+ Tk_Offset(Table, defRowHeight), 0},
+ {TK_CONFIG_INT, "-roworigin", "rowOrigin", "Origin", "0",
+ Tk_Offset(Table, rowOffset), 0},
+ {TK_CONFIG_INT, "-rows", "rows", "Rows", "10", Tk_Offset(Table, rows), 0},
+ {TK_CONFIG_STRING, "-rowseparator", "rowSeparator", "Separator", NULL,
+ Tk_Offset(Table, rowSep), TK_CONFIG_NULL_OK },
+ {TK_CONFIG_CUSTOM, "-rowstretchmode", "rowStretch", "StretchMode", "none",
+ Tk_Offset(Table, rowStretch), 0 , &stretchOpt },
+ {TK_CONFIG_STRING, "-rowtagcommand", "rowTagCommand", "TagCommand", NULL,
+ Tk_Offset(Table, rowTagCmd), TK_CONFIG_NULL_OK },
+ {TK_CONFIG_SYNONYM, "-selcmd", "selectionCommand", (char *)NULL,
+ (char *)NULL, 0, TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-selectioncommand", "selectionCommand",
+ "SelectionCommand", NULL, Tk_Offset(Table, selCmd), TK_CONFIG_NULL_OK },
+ {TK_CONFIG_STRING, "-selectmode", "selectMode", "SelectMode", "browse",
+ Tk_Offset(Table, selectMode), TK_CONFIG_NULL_OK },
+ {TK_CONFIG_BOOLEAN, "-selecttitles", "selectTitles", "SelectTitles", "0",
+ Tk_Offset(Table, selectTitles), 0},
+ {TK_CONFIG_CUSTOM, "-selecttype", "selectType", "SelectType", "cell",
+ Tk_Offset(Table, selectType), 0, &selTypeOpt },
+#ifdef PROCS
+ {TK_CONFIG_BOOLEAN, "-showprocs", "showProcs", "showProcs", "0",
+ Tk_Offset(Table, showProcs), 0},
+#endif
+ {TK_CONFIG_BOOLEAN, "-sparsearray", "sparseArray", "SparseArray", "1",
+ Tk_Offset(Table, sparse), 0},
+ {TK_CONFIG_CUSTOM, "-state", "state", "State", "normal",
+ Tk_Offset(Table, state), 0, &stateTypeOpt},
+ {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus", (char *)NULL,
+ Tk_Offset(Table, takeFocus), TK_CONFIG_NULL_OK },
+ {TK_CONFIG_INT, "-titlecols", "titleCols", "TitleCols", "0",
+ Tk_Offset(Table, titleCols), TK_CONFIG_NULL_OK },
+#ifdef TITLE_CURSOR
+ {TK_CONFIG_CURSOR, "-titlecursor", "titleCursor", "Cursor", "arrow",
+ Tk_Offset(Table, titleCursor), TK_CONFIG_NULL_OK },
+#endif
+ {TK_CONFIG_INT, "-titlerows", "titleRows", "TitleRows", "0",
+ Tk_Offset(Table, titleRows), TK_CONFIG_NULL_OK },
+ {TK_CONFIG_BOOLEAN, "-usecommand", "useCommand", "UseCommand", "1",
+ Tk_Offset(Table, useCmd), 0},
+ {TK_CONFIG_STRING, "-variable", "variable", "Variable", (char *)NULL,
+ Tk_Offset(Table, arrayVar), TK_CONFIG_NULL_OK },
+ {TK_CONFIG_BOOLEAN, "-validate", "validate", "Validate", "0",
+ Tk_Offset(Table, validate), 0},
+ {TK_CONFIG_STRING, "-validatecommand", "validateCommand", "ValidateCommand",
+ "", Tk_Offset(Table, valCmd), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_SYNONYM, "-vcmd", "validateCommand", (char *)NULL,
+ (char *)NULL, 0, TK_CONFIG_NULL_OK},
+ {TK_CONFIG_INT, "-width", "width", "Width", "0",
+ Tk_Offset(Table, maxReqCols), 0},
+ {TK_CONFIG_BOOLEAN, "-wrap", "wrap", "Wrap", "0",
+ Tk_Offset(Table, defaultTag.wrap), 0},
+ {TK_CONFIG_STRING, "-xscrollcommand", "xScrollCommand", "ScrollCommand",
+ NULL, Tk_Offset(Table, xScrollCmd), TK_CONFIG_NULL_OK },
+ {TK_CONFIG_STRING, "-yscrollcommand", "yScrollCommand", "ScrollCommand",
+ NULL, Tk_Offset(Table, yScrollCmd), TK_CONFIG_NULL_OK },
+ {TK_CONFIG_END, (char *)NULL, (char *)NULL, (char *)NULL,
+ (char *)NULL, 0, 0}
+};
+
+/*
+ * This specifies the configure options that will cause an update to
+ * occur, so we should have a quick lookup table for them.
+ * Keep this in sync with the above values.
+ */
+
+static CONST84 char *updateOpts[] = {
+ "-anchor", "-background", "-bg", "-bd",
+ "-borderwidth", "-cache", "-command", "-colorigin",
+ "-cols", "-colstretchmode", "-coltagcommand",
+ "-drawmode", "-fg", "-font", "-foreground",
+ "-hasprocs", "-height", "-highlightbackground",
+ "-highlightcolor", "-highlightthickness", "-insertbackground",
+ "-insertborderwidth", "-insertwidth", "-invertselected",
+ "-ipadx", "-ipady",
+ "-maxheight", "-maxwidth", "-multiline",
+ "-padx", "-pady", "-relief", "-roworigin",
+ "-rows", "-rowstretchmode", "-rowtagcommand",
+ "-showprocs", "-state", "-titlecols", "-titlerows",
+ "-usecommand", "-variable", "-width", "-wrap",
+ "-xscrollcommand", "-yscrollcommand", (char *) NULL
+};
+
+#ifdef HAVE_TCL84
+/*
+ * The structure below defines widget class behavior by means of procedures
+ * that can be invoked from generic window code.
+ */
+
+static Tk_ClassProcs tableClass = {
+ sizeof(Tk_ClassProcs), /* size */
+ TableWorldChanged, /* worldChangedProc */
+ NULL, /* createProc */
+ NULL /* modalProc */
+};
+#endif
+
+#ifdef WIN32
+/*
+ * Some code from TkWinInt.h that we use to correct and speed up
+ * drawing of cells that need clipping in TableDisplay.
+ */
+typedef struct {
+ int type;
+ HWND handle;
+ void *winPtr;
+} TkWinWindow;
+
+typedef struct {
+ int type;
+ HBITMAP handle;
+ Colormap colormap;
+ int depth;
+} TkWinBitmap;
+
+typedef struct {
+ int type;
+ HDC hdc;
+} TkWinDC;
+
+typedef union {
+ int type;
+ TkWinWindow window;
+ TkWinBitmap bitmap;
+ TkWinDC winDC;
+} TkWinDrawable;
+#endif
+
+/*
+ * END HEADER INFORMATION
+ */
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * StringifyObjects -- (from tclCmdAH.c)
+ *
+ * Helper function to bridge the gap between an object-based procedure
+ * and an older string-based procedure.
+ *
+ * Given an array of objects, allocate an array that consists of the
+ * string representations of those objects.
+ *
+ * Results:
+ * The return value is a pointer to the newly allocated array of
+ * strings. Elements 0 to (objc-1) of the string array point to the
+ * string representation of the corresponding element in the source
+ * object array; element objc of the string array is NULL.
+ *
+ * Side effects:
+ * Memory allocated. The caller must eventually free this memory
+ * by calling ckfree() on the return value.
+ *
+ int result;
+ char **argv;
+ argv = StringifyObjects(objc, objv);
+ result = StringBasedCmd(interp, objc, argv);
+ ckfree((char *) argv);
+ return result;
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static char **
+StringifyObjects(objc, objv)
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ int i;
+ char **argv;
+
+ argv = (char **) ckalloc((objc + 1) * sizeof(char *));
+ for (i = 0; i < objc; i++) {
+ argv[i] = Tcl_GetString(objv[i]);
+ }
+ argv[i] = NULL;
+ return argv;
+}
+
+/*
+ * As long as we wait for the Function in general
+ *
+ * This parses the "-class" option for the table.
+ */
+static int
+Tk_ClassOptionObjCmd(Tk_Window tkwin, char *defaultclass,
+ int objc, Tcl_Obj *CONST objv[])
+{
+ char *classname = defaultclass;
+ int offset = 0;
+
+ if ((objc >= 4) && STREQ(Tcl_GetString(objv[2]),"-class")) {
+ classname = Tcl_GetString(objv[3]);
+ offset = 2;
+ }
+ Tk_SetClass(tkwin, classname);
+ return offset;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_TableObjCmd --
+ * This procedure is invoked to process the "table" Tcl
+ * command. See the user documentation for details on what
+ * it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+static int
+Tk_TableObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Main window associated with interpreter. */
+ Tcl_Interp *interp;
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register Table *tablePtr;
+ Tk_Window tkwin, mainWin = (Tk_Window) clientData;
+ int offset;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?");
+ return TCL_ERROR;
+ }
+
+ tkwin = Tk_CreateWindowFromPath(interp, mainWin, Tcl_GetString(objv[1]),
+ (char *)NULL);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+
+ tablePtr = (Table *) ckalloc(sizeof(Table));
+ memset((VOID *) tablePtr, 0, sizeof(Table));
+
+ /*
+ * Set the structure elments that aren't 0/NULL by default,
+ * and that won't be set by the initial configure call.
+ */
+ tablePtr->tkwin = tkwin;
+ tablePtr->display = Tk_Display(tkwin);
+ tablePtr->interp = interp;
+ tablePtr->widgetCmd = Tcl_CreateObjCommand(interp,
+ Tk_PathName(tablePtr->tkwin), TableWidgetObjCmd,
+ (ClientData) tablePtr, (Tcl_CmdDeleteProc *) TableCmdDeletedProc);
+
+ tablePtr->anchorRow = -1;
+ tablePtr->anchorCol = -1;
+ tablePtr->activeRow = -1;
+ tablePtr->activeCol = -1;
+ tablePtr->oldTopRow = -1;
+ tablePtr->oldLeftCol = -1;
+ tablePtr->oldActRow = -1;
+ tablePtr->oldActCol = -1;
+ tablePtr->seen[0] = -1;
+
+ tablePtr->dataSource = DATA_NONE;
+ tablePtr->activeBuf = ckalloc(1);
+ *(tablePtr->activeBuf) = '\0';
+
+ tablePtr->cursor = None;
+ tablePtr->bdcursor = None;
+
+ tablePtr->defaultTag.justify = TK_JUSTIFY_LEFT;
+ tablePtr->defaultTag.state = STATE_UNKNOWN;
+
+ /* misc tables */
+ tablePtr->tagTable = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+ Tcl_InitHashTable(tablePtr->tagTable, TCL_STRING_KEYS);
+ tablePtr->winTable = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+ Tcl_InitHashTable(tablePtr->winTable, TCL_STRING_KEYS);
+
+ /* internal value cache */
+ tablePtr->cache = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+ Tcl_InitHashTable(tablePtr->cache, TCL_STRING_KEYS);
+
+ /* style hash tables */
+ tablePtr->colWidths = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+ Tcl_InitHashTable(tablePtr->colWidths, TCL_ONE_WORD_KEYS);
+ tablePtr->rowHeights = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+ Tcl_InitHashTable(tablePtr->rowHeights, TCL_ONE_WORD_KEYS);
+
+ /* style hash tables */
+ tablePtr->rowStyles = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+ Tcl_InitHashTable(tablePtr->rowStyles, TCL_ONE_WORD_KEYS);
+ tablePtr->colStyles = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+ Tcl_InitHashTable(tablePtr->colStyles, TCL_ONE_WORD_KEYS);
+ tablePtr->cellStyles = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+ Tcl_InitHashTable(tablePtr->cellStyles, TCL_STRING_KEYS);
+
+ /* special style hash tables */
+ tablePtr->flashCells = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+ Tcl_InitHashTable(tablePtr->flashCells, TCL_STRING_KEYS);
+ tablePtr->selCells = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+ Tcl_InitHashTable(tablePtr->selCells, TCL_STRING_KEYS);
+
+ /*
+ * List of tags in priority order. 30 is a good default number to alloc.
+ */
+ tablePtr->tagPrioMax = 30;
+ tablePtr->tagPrioNames = (char **) ckalloc(
+ sizeof(char *) * tablePtr->tagPrioMax);
+ tablePtr->tagPrios = (TableTag **) ckalloc(
+ sizeof(TableTag *) * tablePtr->tagPrioMax);
+ tablePtr->tagPrioSize = 0;
+ for (offset = 0; offset < tablePtr->tagPrioMax; offset++) {
+ tablePtr->tagPrioNames[offset] = (char *) NULL;
+ tablePtr->tagPrios[offset] = (TableTag *) NULL;
+ }
+
+#ifdef PROCS
+ tablePtr->inProc = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+ Tcl_InitHashTable(tablePtr->inProc, TCL_STRING_KEYS);
+#endif
+
+ /*
+ * Handle class name and selection handlers
+ */
+ offset = 2 + Tk_ClassOptionObjCmd(tkwin, "Table", objc, objv);
+#ifdef HAVE_TCL84
+ Tk_SetClassProcs(tkwin, &tableClass, (ClientData) tablePtr);
+#endif
+ Tk_CreateEventHandler(tablePtr->tkwin,
+ PointerMotionMask|ExposureMask|StructureNotifyMask|FocusChangeMask|VisibilityChangeMask,
+ TableEventProc, (ClientData) tablePtr);
+ Tk_CreateSelHandler(tablePtr->tkwin, XA_PRIMARY, XA_STRING,
+ TableFetchSelection, (ClientData) tablePtr, XA_STRING);
+
+ if (TableConfigure(interp, tablePtr, objc - offset, objv + offset,
+ 0, 1 /* force update */) != TCL_OK) {
+ Tk_DestroyWindow(tkwin);
+ return TCL_ERROR;
+ }
+ TableInitTags(tablePtr);
+
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj(Tk_PathName(tablePtr->tkwin), -1));
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TableWidgetObjCmd --
+ * This procedure is invoked to process the Tcl command
+ * that corresponds to a widget managed by this module.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+static int
+TableWidgetObjCmd(clientData, interp, objc, objv)
+ ClientData clientData;
+ Tcl_Interp *interp;
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register Table *tablePtr = (Table *) clientData;
+ int row, col, i, cmdIndex, result = TCL_OK;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
+ return TCL_ERROR;
+ }
+
+ /* parse the first parameter */
+ result = Tcl_GetIndexFromObj(interp, objv[1], commandNames,
+ "option", 0, &cmdIndex);
+ if (result != TCL_OK) {
+ return result;
+ }
+
+ Tcl_Preserve((ClientData) tablePtr);
+ switch ((enum command) cmdIndex) {
+ case CMD_ACTIVATE:
+ result = Table_ActivateCmd(clientData, interp, objc, objv);
+ break;
+
+ case CMD_BBOX:
+ result = Table_BboxCmd(clientData, interp, objc, objv);
+ break;
+
+ case CMD_BORDER:
+ result = Table_BorderCmd(clientData, interp, objc, objv);
+ break;
+
+ case CMD_CGET:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "option");
+ result = TCL_ERROR;
+ } else {
+ result = Tk_ConfigureValue(interp, tablePtr->tkwin, tableSpecs,
+ (char *) tablePtr, Tcl_GetString(objv[2]), 0);
+ }
+ break;
+
+ case CMD_CLEAR:
+ result = Table_ClearCmd(clientData, interp, objc, objv);
+ break;
+
+ case CMD_CONFIGURE:
+ if (objc < 4) {
+ result = Tk_ConfigureInfo(interp, tablePtr->tkwin, tableSpecs,
+ (char *) tablePtr, (objc == 3) ?
+ Tcl_GetString(objv[2]) : (char *) NULL, 0);
+ } else {
+ result = TableConfigure(interp, tablePtr, objc - 2, objv + 2,
+ TK_CONFIG_ARGV_ONLY, 0);
+ }
+ break;
+
+ case CMD_CURSEL:
+ result = Table_CurselectionCmd(clientData, interp, objc, objv);
+ break;
+
+ case CMD_CURVALUE:
+ result = Table_CurvalueCmd(clientData, interp, objc, objv);
+ break;
+
+ case CMD_DELETE:
+ case CMD_INSERT:
+ result = Table_EditCmd(clientData, interp, objc, objv);
+ break;
+
+ case CMD_GET:
+ result = Table_GetCmd(clientData, interp, objc, objv);
+ break;
+
+ case CMD_HEIGHT:
+ case CMD_WIDTH:
+ result = Table_AdjustCmd(clientData, interp, objc, objv);
+ break;
+
+ case CMD_HIDDEN:
+ result = Table_HiddenCmd(clientData, interp, objc, objv);
+ break;
+
+ case CMD_ICURSOR:
+ if (objc != 2 && objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?cursorPos?");
+ result = TCL_ERROR;
+ break;
+ }
+ if (!(tablePtr->flags & HAS_ACTIVE) ||
+ (tablePtr->flags & ACTIVE_DISABLED) ||
+ tablePtr->state == STATE_DISABLED) {
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(-1));
+ break;
+ } else if (objc == 3) {
+ if (TableGetIcursorObj(tablePtr, objv[2], NULL) != TCL_OK) {
+ result = TCL_ERROR;
+ break;
+ }
+ TableRefresh(tablePtr, tablePtr->activeRow,
+ tablePtr->activeCol, CELL);
+ }
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(tablePtr->icursor));
+ break;
+
+ case CMD_INDEX: {
+ char *which = NULL;
+
+ if (objc == 4) {
+ which = Tcl_GetString(objv[3]);
+ }
+ if ((objc < 3 || objc > 4) ||
+ ((objc == 4) && (strcmp(which, "row")
+ && strcmp(which, "col")))) {
+ Tcl_WrongNumArgs(interp, 2, objv, " ?row|col?");
+ result = TCL_ERROR;
+ } else if (TableGetIndexObj(tablePtr, objv[2], &row, &col)
+ != TCL_OK) {
+ result = TCL_ERROR;
+ } else if (objc == 3) {
+ char buf[INDEX_BUFSIZE];
+ /* recreate the index, just in case it got bounded */
+ TableMakeArrayIndex(row, col, buf);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, -1));
+ } else { /* INDEX row|col */
+ Tcl_SetObjResult(interp,
+ Tcl_NewIntObj((*which == 'r') ? row : col));
+ }
+ break;
+ }
+
+#ifdef POSTSCRIPT
+ case CMD_POSTSCRIPT:
+ result = Table_PostscriptCmd(clientData, interp, objc, objv);
+ break;
+#endif
+
+ case CMD_REREAD:
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, NULL);
+ result = TCL_ERROR;
+ } else if ((tablePtr->flags & HAS_ACTIVE) &&
+ !(tablePtr->flags & ACTIVE_DISABLED) &&
+ tablePtr->state != STATE_DISABLED) {
+ TableGetActiveBuf(tablePtr);
+ TableRefresh(tablePtr, tablePtr->activeRow,
+ tablePtr->activeCol, CELL|INV_FORCE);
+ }
+ break;
+
+ case CMD_SCAN:
+ result = Table_ScanCmd(clientData, interp, objc, objv);
+ break;
+
+ case CMD_SEE:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "index");
+ result = TCL_ERROR;
+ } else if (TableGetIndexObj(tablePtr, objv[2],
+ &row, &col) == TCL_ERROR) {
+ result = TCL_ERROR;
+ } else {
+ /* Adjust from user to master coords */
+ row -= tablePtr->rowOffset;
+ col -= tablePtr->colOffset;
+ if (!TableCellVCoords(tablePtr, row, col, &i, &i, &i, &i, 1)) {
+ tablePtr->topRow = row-1;
+ tablePtr->leftCol = col-1;
+ TableAdjustParams(tablePtr);
+ }
+ }
+ break;
+
+ case CMD_SELECTION:
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "option ?arg arg ...?");
+ result = TCL_ERROR;
+ break;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[2], selCmdNames,
+ "selection option", 0, &cmdIndex) != TCL_OK) {
+ result = TCL_ERROR;
+ break;
+ }
+ switch ((enum selCommand) cmdIndex) {
+ case CMD_SEL_ANCHOR:
+ result = Table_SelAnchorCmd(clientData, interp,
+ objc, objv);
+ break;
+ case CMD_SEL_CLEAR:
+ result = Table_SelClearCmd(clientData, interp, objc, objv);
+ break;
+ case CMD_SEL_INCLUDES:
+ result = Table_SelIncludesCmd(clientData, interp,
+ objc, objv);
+ break;
+ case CMD_SEL_PRESENT: {
+ Tcl_HashSearch search;
+ int present = (Tcl_FirstHashEntry(tablePtr->selCells,
+ &search) != NULL);
+
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(present));
+ break;
+ }
+ case CMD_SEL_SET:
+ result = Table_SelSetCmd(clientData, interp, objc, objv);
+ break;
+ }
+ break;
+
+ case CMD_SET:
+ result = Table_SetCmd(clientData, interp, objc, objv);
+ break;
+
+ case CMD_SPANS:
+ result = Table_SpanCmd(clientData, interp, objc, objv);
+ break;
+
+ case CMD_TAG:
+ result = Table_TagCmd(clientData, interp, objc, objv);
+ break;
+
+ case CMD_VALIDATE:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "index");
+ result = TCL_ERROR;
+ } else if (TableGetIndexObj(tablePtr, objv[2],
+ &row, &col) == TCL_ERROR) {
+ result = TCL_ERROR;
+ } else {
+ i = tablePtr->validate;
+ tablePtr->validate = 1;
+ result = TableValidateChange(tablePtr, row, col, (char *) NULL,
+ (char *) NULL, -1);
+ tablePtr->validate = i;
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result == TCL_OK));
+ result = TCL_OK;
+ }
+ break;
+
+ case CMD_VERSION:
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, NULL);
+ result = TCL_ERROR;
+ } else {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(PACKAGE_VERSION, -1));
+ }
+ break;
+
+ case CMD_WINDOW:
+ result = Table_WindowCmd(clientData, interp, objc, objv);
+ break;
+
+ case CMD_XVIEW:
+ case CMD_YVIEW:
+ result = Table_ViewCmd(clientData, interp, objc, objv);
+ break;
+ }
+
+ Tcl_Release((ClientData) tablePtr);
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableDestroy --
+ * This procedure is invoked by Tcl_EventuallyFree
+ * to clean up the internal structure of a table at a safe time
+ * (when no-one is using it anymore).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Everything associated with the table is freed up (hopefully).
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+TableDestroy(ClientData clientdata)
+{
+ register Table *tablePtr = (Table *) clientdata;
+ Tcl_HashEntry *entryPtr;
+ Tcl_HashSearch search;
+
+ /* These may be repetitive from DestroyNotify, but it doesn't hurt */
+ /* cancel any pending update or timer */
+ if (tablePtr->flags & REDRAW_PENDING) {
+ Tcl_CancelIdleCall(TableDisplay, (ClientData) tablePtr);
+ tablePtr->flags &= ~REDRAW_PENDING;
+ }
+ Tcl_DeleteTimerHandler(tablePtr->cursorTimer);
+ Tcl_DeleteTimerHandler(tablePtr->flashTimer);
+
+ /* delete the variable trace */
+ if (tablePtr->arrayVar != NULL) {
+ Tcl_UntraceVar(tablePtr->interp, tablePtr->arrayVar,
+ TCL_TRACE_WRITES | TCL_TRACE_UNSETS | TCL_GLOBAL_ONLY,
+ (Tcl_VarTraceProc *)TableVarProc, (ClientData) tablePtr);
+ }
+
+ /* free the int arrays */
+ if (tablePtr->colPixels) ckfree((char *) tablePtr->colPixels);
+ if (tablePtr->rowPixels) ckfree((char *) tablePtr->rowPixels);
+ if (tablePtr->colStarts) ckfree((char *) tablePtr->colStarts);
+ if (tablePtr->rowStarts) ckfree((char *) tablePtr->rowStarts);
+
+ /* delete cached active tag and string */
+ if (tablePtr->activeTagPtr) ckfree((char *) tablePtr->activeTagPtr);
+ if (tablePtr->activeBuf != NULL) ckfree(tablePtr->activeBuf);
+
+ /*
+ * Delete the various hash tables, make sure to clear the STRING_KEYS
+ * tables that allocate their strings:
+ * cache, spanTbl (spanAffTbl shares spanTbl info)
+ */
+ Table_ClearHashTable(tablePtr->cache);
+ ckfree((char *) (tablePtr->cache));
+ Tcl_DeleteHashTable(tablePtr->rowStyles);
+ ckfree((char *) (tablePtr->rowStyles));
+ Tcl_DeleteHashTable(tablePtr->colStyles);
+ ckfree((char *) (tablePtr->colStyles));
+ Tcl_DeleteHashTable(tablePtr->cellStyles);
+ ckfree((char *) (tablePtr->cellStyles));
+ Tcl_DeleteHashTable(tablePtr->flashCells);
+ ckfree((char *) (tablePtr->flashCells));
+ Tcl_DeleteHashTable(tablePtr->selCells);
+ ckfree((char *) (tablePtr->selCells));
+ Tcl_DeleteHashTable(tablePtr->colWidths);
+ ckfree((char *) (tablePtr->colWidths));
+ Tcl_DeleteHashTable(tablePtr->rowHeights);
+ ckfree((char *) (tablePtr->rowHeights));
+#ifdef PROCS
+ Tcl_DeleteHashTable(tablePtr->inProc);
+ ckfree((char *) (tablePtr->inProc));
+#endif
+ if (tablePtr->spanTbl) {
+ Table_ClearHashTable(tablePtr->spanTbl);
+ ckfree((char *) (tablePtr->spanTbl));
+ Tcl_DeleteHashTable(tablePtr->spanAffTbl);
+ ckfree((char *) (tablePtr->spanAffTbl));
+ }
+
+ /* Now free up all the tag information */
+ for (entryPtr = Tcl_FirstHashEntry(tablePtr->tagTable, &search);
+ entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&search)) {
+ TableCleanupTag(tablePtr, (TableTag *) Tcl_GetHashValue(entryPtr));
+ ckfree((char *) Tcl_GetHashValue(entryPtr));
+ }
+ /* free up the stuff in the default tag */
+ TableCleanupTag(tablePtr, &(tablePtr->defaultTag));
+ /* And delete the actual hash table */
+ Tcl_DeleteHashTable(tablePtr->tagTable);
+ ckfree((char *) (tablePtr->tagTable));
+ ckfree((char *) (tablePtr->tagPrios));
+ ckfree((char *) (tablePtr->tagPrioNames));
+
+ /* Now free up all the embedded window info */
+ for (entryPtr = Tcl_FirstHashEntry(tablePtr->winTable, &search);
+ entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&search)) {
+ EmbWinDelete(tablePtr, (TableEmbWindow *) Tcl_GetHashValue(entryPtr));
+ }
+ /* And delete the actual hash table */
+ Tcl_DeleteHashTable(tablePtr->winTable);
+ ckfree((char *) (tablePtr->winTable));
+
+ /* free the configuration options in the widget */
+ Tk_FreeOptions(tableSpecs, (char *) tablePtr, tablePtr->display, 0);
+
+ /* and free the widget memory at last! */
+ ckfree((char *) (tablePtr));
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableConfigure --
+ * This procedure is called to process an objc/objv list, plus
+ * the Tk option database, in order to configure (or reconfigure)
+ * a table widget.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If TCL_ERROR is
+ * returned, then interp result contains an error message.
+ *
+ * Side effects:
+ * Configuration information, such as colors, border width, etc.
+ * get set for tablePtr; old resources get freed, if there were any.
+ * Certain values might be constrained.
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+TableConfigure(interp, tablePtr, objc, objv, flags, forceUpdate)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ register Table *tablePtr; /* Information about widget; may or may
+ * not already have values for some fields. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+ int flags; /* Flags to pass to Tk_ConfigureWidget. */
+ int forceUpdate; /* Whether to force an update - required
+ * for initial configuration */
+{
+ Tcl_HashSearch search;
+ int oldUse, oldCaching, oldExport, oldTitleRows, oldTitleCols;
+ int result = TCL_OK;
+ char *oldVar = NULL, **argv;
+ Tcl_DString error;
+ Tk_FontMetrics fm;
+
+ oldExport = tablePtr->exportSelection;
+ oldCaching = tablePtr->caching;
+ oldUse = tablePtr->useCmd;
+ oldTitleRows = tablePtr->titleRows;
+ oldTitleCols = tablePtr->titleCols;
+ if (tablePtr->arrayVar != NULL) {
+ oldVar = ckalloc(strlen(tablePtr->arrayVar) + 1);
+ strcpy(oldVar, tablePtr->arrayVar);
+ }
+
+ /* Do the configuration */
+ argv = StringifyObjects(objc, objv);
+ result = Tk_ConfigureWidget(interp, tablePtr->tkwin, tableSpecs,
+ objc, (CONST84 char **) argv, (char *) tablePtr, flags);
+ ckfree((char *) argv);
+ if (result != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ Tcl_DStringInit(&error);
+
+ /* Any time we configure, reevaluate what our data source is */
+ tablePtr->dataSource = DATA_NONE;
+ if (tablePtr->caching) {
+ tablePtr->dataSource |= DATA_CACHE;
+ }
+ if (tablePtr->command && tablePtr->useCmd) {
+ tablePtr->dataSource |= DATA_COMMAND;
+ } else if (tablePtr->arrayVar) {
+ tablePtr->dataSource |= DATA_ARRAY;
+ }
+
+ /* Check to see if the array variable was changed */
+ if (strcmp((tablePtr->arrayVar ? tablePtr->arrayVar : ""),
+ (oldVar ? oldVar : ""))) {
+ /* only do the following if arrayVar is our data source */
+ if (tablePtr->dataSource & DATA_ARRAY) {
+ /*
+ * ensure that the cache will flush later
+ * so it gets the new values
+ */
+ oldCaching = !(tablePtr->caching);
+ }
+ /* remove the trace on the old array variable if there was one */
+ if (oldVar != NULL)
+ Tcl_UntraceVar(interp, oldVar,
+ TCL_TRACE_WRITES|TCL_TRACE_UNSETS|TCL_GLOBAL_ONLY,
+ (Tcl_VarTraceProc *)TableVarProc, (ClientData) tablePtr);
+ /* Check whether variable is an array and trace it if it is */
+ if (tablePtr->arrayVar != NULL) {
+ /* does the variable exist as an array? */
+ if (Tcl_SetVar2(interp, tablePtr->arrayVar, TEST_KEY, "",
+ TCL_GLOBAL_ONLY) == NULL) {
+ Tcl_DStringAppend(&error, "invalid variable value \"", -1);
+ Tcl_DStringAppend(&error, tablePtr->arrayVar, -1);
+ Tcl_DStringAppend(&error, "\": could not be made an array",
+ -1);
+ ckfree(tablePtr->arrayVar);
+ tablePtr->arrayVar = NULL;
+ tablePtr->dataSource &= ~DATA_ARRAY;
+ result = TCL_ERROR;
+ } else {
+ Tcl_UnsetVar2(interp, tablePtr->arrayVar, TEST_KEY,
+ TCL_GLOBAL_ONLY);
+ /* remove the effect of the evaluation */
+ /* set a trace on the variable */
+ Tcl_TraceVar(interp, tablePtr->arrayVar,
+ TCL_TRACE_WRITES|TCL_TRACE_UNSETS|TCL_GLOBAL_ONLY,
+ (Tcl_VarTraceProc *)TableVarProc,
+ (ClientData) tablePtr);
+
+ /* only do the following if arrayVar is our data source */
+ if (tablePtr->dataSource & DATA_ARRAY) {
+ /* get the current value of the selection */
+ TableGetActiveBuf(tablePtr);
+ }
+ }
+ }
+ }
+
+ /* Free oldVar if it was allocated */
+ if (oldVar != NULL) ckfree(oldVar);
+
+ if ((tablePtr->command && tablePtr->useCmd && !oldUse) ||
+ (tablePtr->arrayVar && !(tablePtr->useCmd) && oldUse)) {
+ /*
+ * Our effective data source changed, so flush and
+ * retrieve new active buffer
+ */
+ Table_ClearHashTable(tablePtr->cache);
+ Tcl_InitHashTable(tablePtr->cache, TCL_STRING_KEYS);
+ TableGetActiveBuf(tablePtr);
+ forceUpdate = 1;
+ } else if (oldCaching != tablePtr->caching) {
+ /*
+ * Caching changed, so just clear the cache for safety
+ */
+ Table_ClearHashTable(tablePtr->cache);
+ Tcl_InitHashTable(tablePtr->cache, TCL_STRING_KEYS);
+ forceUpdate = 1;
+ }
+
+ /*
+ * Set up the default column width and row height
+ */
+ Tk_GetFontMetrics(tablePtr->defaultTag.tkfont, &fm);
+ tablePtr->charWidth = Tk_TextWidth(tablePtr->defaultTag.tkfont, "0", 1);
+ tablePtr->charHeight = fm.linespace + 2;
+
+ if (tablePtr->insertWidth <= 0) {
+ tablePtr->insertWidth = 2;
+ }
+ if (tablePtr->insertBorderWidth > tablePtr->insertWidth/2) {
+ tablePtr->insertBorderWidth = tablePtr->insertWidth/2;
+ }
+ tablePtr->highlightWidth = MAX(0,tablePtr->highlightWidth);
+
+ /*
+ * Ensure that certain values are within proper constraints
+ */
+ tablePtr->rows = MAX(1, tablePtr->rows);
+ tablePtr->cols = MAX(1, tablePtr->cols);
+ tablePtr->padX = MAX(0, tablePtr->padX);
+ tablePtr->padY = MAX(0, tablePtr->padY);
+ tablePtr->ipadX = MAX(0, tablePtr->ipadX);
+ tablePtr->ipadY = MAX(0, tablePtr->ipadY);
+ tablePtr->maxReqCols = MAX(0, tablePtr->maxReqCols);
+ tablePtr->maxReqRows = MAX(0, tablePtr->maxReqRows);
+ CONSTRAIN(tablePtr->titleRows, 0, tablePtr->rows);
+ CONSTRAIN(tablePtr->titleCols, 0, tablePtr->cols);
+
+ /*
+ * Handle change of default border style
+ * The default borderwidth must be >= 0.
+ */
+ if (tablePtr->drawMode & (DRAW_MODE_SINGLE|DRAW_MODE_FAST)) {
+ /*
+ * When drawing fast or single, the border must be <= 1.
+ * We have to do this after the normal configuration
+ * to base the borders off the first value given.
+ */
+ tablePtr->defaultTag.bd[0] = MIN(1, tablePtr->defaultTag.bd[0]);
+ tablePtr->defaultTag.borders = 1;
+ ckfree((char *) tablePtr->defaultTag.borderStr);
+ tablePtr->defaultTag.borderStr = (char *) ckalloc(2);
+ strcpy(tablePtr->defaultTag.borderStr,
+ tablePtr->defaultTag.bd[0] ? "1" : "0");
+ }
+
+ /*
+ * Claim the selection if we've suddenly started exporting it and
+ * there is a selection to export.
+ */
+ if (tablePtr->exportSelection && !oldExport &&
+ (Tcl_FirstHashEntry(tablePtr->selCells, &search) != NULL)) {
+ Tk_OwnSelection(tablePtr->tkwin, XA_PRIMARY, TableLostSelection,
+ (ClientData) tablePtr);
+ }
+
+ if ((tablePtr->titleRows < oldTitleRows) ||
+ (tablePtr->titleCols < oldTitleCols)) {
+ /*
+ * Prevent odd movement due to new possible topleft index
+ */
+ if (tablePtr->titleRows < oldTitleRows)
+ tablePtr->topRow -= oldTitleRows - tablePtr->titleRows;
+ if (tablePtr->titleCols < oldTitleCols)
+ tablePtr->leftCol -= oldTitleCols - tablePtr->titleCols;
+ /*
+ * If our title area shrank, we need to check that the items
+ * within the new title area don't try to span outside it.
+ */
+ TableSpanSanCheck(tablePtr);
+ }
+
+ /*
+ * Only do the full reconfigure if absolutely necessary
+ */
+ if (!forceUpdate) {
+ int i, dummy;
+ for (i = 0; i < objc-1; i += 2) {
+ if (Tcl_GetIndexFromObj(NULL, objv[i], updateOpts, "", 0, &dummy)
+ == TCL_OK) {
+ forceUpdate = 1;
+ break;
+ }
+ }
+ }
+ if (forceUpdate) {
+ /*
+ * Calculate the row and column starts
+ * Adjust the top left corner of the internal display
+ */
+ TableAdjustParams(tablePtr);
+ /* reset the cursor */
+ TableConfigCursor(tablePtr);
+ /* set up the background colour in the window */
+ Tk_SetBackgroundFromBorder(tablePtr->tkwin, tablePtr->defaultTag.bg);
+ /* set the geometry and border */
+ TableGeometryRequest(tablePtr);
+ Tk_SetInternalBorder(tablePtr->tkwin, tablePtr->highlightWidth);
+ /* invalidate the whole table */
+ TableInvalidateAll(tablePtr, INV_HIGHLIGHT);
+ }
+ /*
+ * FIX this is goofy because the result could be munged by other
+ * functions. Could be improved.
+ */
+ Tcl_ResetResult(interp);
+ if (result == TCL_ERROR) {
+ Tcl_AddErrorInfo(interp, "\t(configuring table widget)");
+ Tcl_DStringResult(interp, &error);
+ }
+ Tcl_DStringFree(&error);
+ return result;
+}
+#ifdef HAVE_TCL84
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TableWorldChanged --
+ *
+ * This procedure is called when the world has changed in some
+ * way and the widget needs to recompute all its graphics contexts
+ * and determine its new geometry.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Entry will be relayed out and redisplayed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+TableWorldChanged(instanceData)
+ ClientData instanceData; /* Information about widget. */
+{
+ Table *tablePtr = (Table *) instanceData;
+ Tk_FontMetrics fm;
+
+ /*
+ * Set up the default column width and row height
+ */
+ Tk_GetFontMetrics(tablePtr->defaultTag.tkfont, &fm);
+ tablePtr->charWidth = Tk_TextWidth(tablePtr->defaultTag.tkfont, "0", 1);
+ tablePtr->charHeight = fm.linespace + 2;
+
+ /*
+ * Recompute the window's geometry and arrange for it to be redisplayed.
+ */
+
+ TableAdjustParams(tablePtr);
+ TableGeometryRequest(tablePtr);
+ Tk_SetInternalBorder(tablePtr->tkwin, tablePtr->highlightWidth);
+ /* invalidate the whole table */
+ TableInvalidateAll(tablePtr, INV_HIGHLIGHT);
+}
+#endif
+/*
+ *--------------------------------------------------------------
+ *
+ * TableEventProc --
+ * This procedure is invoked by the Tk dispatcher for various
+ * events on tables.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When the window gets deleted, internal structures get
+ * cleaned up. When it gets exposed, it is redisplayed.
+ *
+ *--------------------------------------------------------------
+ */
+static void
+TableEventProc(clientData, eventPtr)
+ ClientData clientData; /* Information about window. */
+ XEvent *eventPtr; /* Information about event. */
+{
+ Table *tablePtr = (Table *) clientData;
+ int row, col;
+
+ switch (eventPtr->type) {
+ case MotionNotify:
+ if (!(tablePtr->resize & SEL_NONE)
+ && (tablePtr->bdcursor != None) &&
+ TableAtBorder(tablePtr, eventPtr->xmotion.x,
+ eventPtr->xmotion.y, &row, &col) &&
+ ((row>=0 && (tablePtr->resize & SEL_ROW)) ||
+ (col>=0 && (tablePtr->resize & SEL_COL)))) {
+ /*
+ * The bordercursor is defined and we meet the criteria for
+ * being over a border. Set the cursor to border if not
+ * already done.
+ */
+ if (!(tablePtr->flags & OVER_BORDER)) {
+ tablePtr->flags |= OVER_BORDER;
+ Tk_DefineCursor(tablePtr->tkwin, tablePtr->bdcursor);
+ }
+ } else if (tablePtr->flags & OVER_BORDER) {
+ tablePtr->flags &= ~OVER_BORDER;
+ if (tablePtr->cursor != None) {
+ Tk_DefineCursor(tablePtr->tkwin, tablePtr->cursor);
+ } else {
+ Tk_UndefineCursor(tablePtr->tkwin);
+ }
+#ifdef TITLE_CURSOR
+ } else if (tablePtr->flags & (OVER_BORDER|OVER_TITLE)) {
+ Tk_Cursor cursor = tablePtr->cursor;
+
+ //tablePtr->flags &= ~(OVER_BORDER|OVER_TITLE);
+
+ if (tablePtr->titleCursor != None) {
+ TableWhatCell(tablePtr, eventPtr->xmotion.x,
+ eventPtr->xmotion.y, &row, &col);
+ if ((row < tablePtr->titleRows) ||
+ (col < tablePtr->titleCols)) {
+ if (tablePtr->flags & OVER_TITLE) {
+ break;
+ }
+ tablePtr->flags |= OVER_TITLE;
+ cursor = tablePtr->titleCursor;
+ }
+ }
+ if (cursor != None) {
+ Tk_DefineCursor(tablePtr->tkwin, cursor);
+ } else {
+ Tk_UndefineCursor(tablePtr->tkwin);
+ }
+ } else if (tablePtr->titleCursor != None) {
+ Tk_Cursor cursor = tablePtr->cursor;
+
+ TableWhatCell(tablePtr, eventPtr->xmotion.x,
+ eventPtr->xmotion.y, &row, &col);
+ if ((row < tablePtr->titleRows) ||
+ (col < tablePtr->titleCols)) {
+ if (tablePtr->flags & OVER_TITLE) {
+ break;
+ }
+ tablePtr->flags |= OVER_TITLE;
+ cursor = tablePtr->titleCursor;
+ }
+#endif
+ }
+ break;
+
+ case Expose:
+ TableInvalidate(tablePtr, eventPtr->xexpose.x, eventPtr->xexpose.y,
+ eventPtr->xexpose.width, eventPtr->xexpose.height,
+ INV_HIGHLIGHT);
+ break;
+
+ case DestroyNotify:
+ /* remove the command from the interpreter */
+ if (tablePtr->tkwin != NULL) {
+ tablePtr->tkwin = NULL;
+ Tcl_DeleteCommandFromToken(tablePtr->interp,
+ tablePtr->widgetCmd);
+ }
+
+ /* cancel any pending update or timer */
+ if (tablePtr->flags & REDRAW_PENDING) {
+ Tcl_CancelIdleCall(TableDisplay, (ClientData) tablePtr);
+ tablePtr->flags &= ~REDRAW_PENDING;
+ }
+ Tcl_DeleteTimerHandler(tablePtr->cursorTimer);
+ Tcl_DeleteTimerHandler(tablePtr->flashTimer);
+
+ Tcl_EventuallyFree((ClientData) tablePtr,
+ (Tcl_FreeProc *) TableDestroy);
+ break;
+
+ case MapNotify: /* redraw table when remapped if it changed */
+ if (tablePtr->flags & REDRAW_ON_MAP) {
+ tablePtr->flags &= ~REDRAW_ON_MAP;
+ Tcl_Preserve((ClientData) tablePtr);
+ TableAdjustParams(tablePtr);
+ TableInvalidateAll(tablePtr, INV_HIGHLIGHT);
+ Tcl_Release((ClientData) tablePtr);
+ }
+ break;
+
+ case ConfigureNotify:
+ Tcl_Preserve((ClientData) tablePtr);
+ TableAdjustParams(tablePtr);
+ TableInvalidateAll(tablePtr, INV_HIGHLIGHT);
+ Tcl_Release((ClientData) tablePtr);
+ break;
+
+ case FocusIn:
+ case FocusOut:
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ tablePtr->flags |= REDRAW_BORDER;
+ if (eventPtr->type == FocusOut) {
+ tablePtr->flags &= ~HAS_FOCUS;
+ } else {
+ tablePtr->flags |= HAS_FOCUS;
+ }
+ TableRedrawHighlight(tablePtr);
+ /* cancel the timer */
+ TableConfigCursor(tablePtr);
+ }
+ break;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableCmdDeletedProc --
+ *
+ * This procedure is invoked when a widget command is deleted. If
+ * the widget isn't already in the process of being destroyed,
+ * this command destroys it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The widget is destroyed.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+TableCmdDeletedProc(ClientData clientData)
+{
+ Table *tablePtr = (Table *) clientData;
+ Tk_Window tkwin;
+
+ /*
+ * This procedure could be invoked either because the window was
+ * destroyed and the command was then deleted (in which case tkwin
+ * is NULL) or because the command was deleted, and then this procedure
+ * destroys the widget.
+ */
+
+ if (tablePtr->tkwin != NULL) {
+ tkwin = tablePtr->tkwin;
+ tablePtr->tkwin = NULL;
+ Tk_DestroyWindow(tkwin);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableRedrawHighlight --
+ * Redraws just the highlight for the window
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+TableRedrawHighlight(Table *tablePtr)
+{
+ if ((tablePtr->flags & REDRAW_BORDER) && tablePtr->highlightWidth > 0) {
+ GC gc = Tk_GCForColor((tablePtr->flags & HAS_FOCUS)
+ ? tablePtr->highlightColorPtr : tablePtr->highlightBgColorPtr,
+ Tk_WindowId(tablePtr->tkwin));
+ Tk_DrawFocusHighlight(tablePtr->tkwin, gc, tablePtr->highlightWidth,
+ Tk_WindowId(tablePtr->tkwin));
+ }
+ tablePtr->flags &= ~REDRAW_BORDER;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableRefresh --
+ * Refreshes an area of the table based on the mode.
+ * row,col in real coords (0-based)
+ *
+ * Results:
+ * Will cause redraw for visible cells
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+void
+TableRefresh(register Table *tablePtr, int row, int col, int mode)
+{
+ int x, y, w, h;
+
+ if ((row < 0) || (col < 0)) {
+ /*
+ * Invalid coords passed in. This can happen when the "active" cell
+ * is refreshed, but doesn't really exist (row==-1 && col==-1).
+ */
+ return;
+ }
+ if (mode & CELL) {
+ if (TableCellVCoords(tablePtr, row, col, &x, &y, &w, &h, 0)) {
+ TableInvalidate(tablePtr, x, y, w, h, mode);
+ }
+ } else if (mode & ROW) {
+ /* get the position of the leftmost cell in the row */
+ if ((mode & INV_FILL) && row < tablePtr->topRow) {
+ /* Invalidate whole table */
+ TableInvalidateAll(tablePtr, mode);
+ } else if (TableCellVCoords(tablePtr, row, tablePtr->leftCol,
+ &x, &y, &w, &h, 0)) {
+ /* Invalidate from this row, maybe to end */
+ TableInvalidate(tablePtr, 0, y, Tk_Width(tablePtr->tkwin),
+ (mode&INV_FILL)?Tk_Height(tablePtr->tkwin):h, mode);
+ }
+ } else if (mode & COL) {
+ /* get the position of the topmost cell on the column */
+ if ((mode & INV_FILL) && col < tablePtr->leftCol) {
+ /* Invalidate whole table */
+ TableInvalidateAll(tablePtr, mode);
+ } else if (TableCellVCoords(tablePtr, tablePtr->topRow, col,
+ &x, &y, &w, &h, 0)) {
+ /* Invalidate from this column, maybe to end */
+ TableInvalidate(tablePtr, x, 0,
+ (mode&INV_FILL)?Tk_Width(tablePtr->tkwin):w,
+ Tk_Height(tablePtr->tkwin), mode);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableGetGc --
+ * Gets a GC corresponding to the tag structure passed.
+ *
+ * Results:
+ * Returns usable GC.
+ *
+ * Side effects:
+ * None
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+TableGetGc(Display *display, Drawable d, TableTag *tagPtr, GC *tagGc)
+{
+ XGCValues gcValues;
+ gcValues.foreground = Tk_3DBorderColor(tagPtr->fg)->pixel;
+ gcValues.background = Tk_3DBorderColor(tagPtr->bg)->pixel;
+ gcValues.font = Tk_FontId(tagPtr->tkfont);
+ if (*tagGc == NULL) {
+ gcValues.graphics_exposures = False;
+ *tagGc = XCreateGC(display, d,
+ GCForeground|GCBackground|GCFont|GCGraphicsExposures,
+ &gcValues);
+ } else {
+ XChangeGC(display, *tagGc, GCForeground|GCBackground|GCFont,
+ &gcValues);
+ }
+}
+
+#define TableFreeGc XFreeGC
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TableUndisplay --
+ * This procedure removes the contents of a table window
+ * that have been moved offscreen.
+ *
+ * Results:
+ * Embedded windows can be unmapped.
+ *
+ * Side effects:
+ * Information disappears from the screen.
+ *
+ *--------------------------------------------------------------
+ */
+static void
+TableUndisplay(register Table *tablePtr)
+{
+ register int *seen = tablePtr->seen;
+ int row, col;
+
+ /* We need to find out the true last cell, not considering spans */
+ tablePtr->flags |= AVOID_SPANS;
+ TableGetLastCell(tablePtr, &row, &col);
+ tablePtr->flags &= ~AVOID_SPANS;
+
+ if (seen[0] != -1) {
+ if (seen[0] < tablePtr->topRow) {
+ /* Remove now hidden rows */
+ EmbWinUnmap(tablePtr, seen[0], MIN(seen[2],tablePtr->topRow-1),
+ seen[1], seen[3]);
+ /* Also account for the title area */
+ EmbWinUnmap(tablePtr, seen[0], MIN(seen[2],tablePtr->topRow-1),
+ 0, tablePtr->titleCols-1);
+ }
+ if (seen[1] < tablePtr->leftCol) {
+ /* Remove now hidden cols */
+ EmbWinUnmap(tablePtr, seen[0], seen[2],
+ seen[1], MAX(seen[3],tablePtr->leftCol-1));
+ /* Also account for the title area */
+ EmbWinUnmap(tablePtr, 0, tablePtr->titleRows-1,
+ seen[1], MAX(seen[3],tablePtr->leftCol-1));
+ }
+ if (seen[2] > row) {
+ /* Remove now off-screen rows */
+ EmbWinUnmap(tablePtr, MAX(seen[0],row+1), seen[2],
+ seen[1], seen[3]);
+ /* Also account for the title area */
+ EmbWinUnmap(tablePtr, MAX(seen[0],row+1), seen[2],
+ 0, tablePtr->titleCols-1);
+ }
+ if (seen[3] > col) {
+ /* Remove now off-screen cols */
+ EmbWinUnmap(tablePtr, seen[0], seen[2],
+ MAX(seen[1],col+1), seen[3]);
+ /* Also account for the title area */
+ EmbWinUnmap(tablePtr, 0, tablePtr->titleRows-1,
+ MAX(seen[1],col+1), seen[3]);
+ }
+ }
+ seen[0] = tablePtr->topRow;
+ seen[1] = tablePtr->leftCol;
+ seen[2] = row;
+ seen[3] = col;
+}
+
+/*
+ * Generally we should be able to use XSetClipRectangles on X11, but
+ * the addition of Xft drawing to Tk 8.5+ completely ignores the clip
+ * rectangles. Thus turn it off for all cases until clip rectangles
+ * are known to be respected. [Bug 1805350]
+ */
+#if 1 || defined(MAC_TCL) || defined(UNDER_CE) || (defined(WIN32) && defined(TCL_THREADS)) || defined(MAC_OSX_TK)
+#define NO_XSETCLIP
+#endif
+/*
+ *--------------------------------------------------------------
+ *
+ * TableDisplay --
+ * This procedure redraws the contents of a table window.
+ * The conditional code in this function is due to these factors:
+ * o Lack of XSetClipRectangles on Macintosh
+ * o Use of alternative routine for Windows
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information appears on the screen.
+ *
+ *--------------------------------------------------------------
+ */
+static void
+TableDisplay(ClientData clientdata)
+{
+ register Table *tablePtr = (Table *) clientdata;
+ Tk_Window tkwin = tablePtr->tkwin;
+ Display *display = tablePtr->display;
+ Drawable window;
+#ifdef NO_XSETCLIP
+ Drawable clipWind;
+#elif defined(WIN32)
+ TkWinDrawable *twdPtr;
+ HDC dc;
+ HRGN clipR;
+#else
+ XRectangle clipRect;
+#endif
+ int rowFrom, rowTo, colFrom, colTo,
+ invalidX, invalidY, invalidWidth, invalidHeight,
+ x, y, width, height, itemX, itemY, itemW, itemH,
+ row, col, urow, ucol, hrow=0, hcol=0, cx, cy, cw, ch, borders, bd[6],
+ numBytes, new, boundW, boundH, maxW, maxH, cellType,
+ originX, originY, activeCell, shouldInvert, ipadx, ipady, padx, pady;
+ GC tagGc = NULL, topGc, bottomGc;
+ char *string = NULL;
+ char buf[INDEX_BUFSIZE];
+ TableTag *tagPtr = NULL, *titlePtr, *selPtr, *activePtr, *flashPtr,
+ *rowPtr, *colPtr;
+ Tcl_HashEntry *entryPtr;
+ static XPoint rect[3] = { {0, 0}, {0, 0}, {0, 0} };
+ Tcl_HashTable *colTagsCache = NULL;
+ Tcl_HashTable *drawnCache = NULL;
+ Tk_TextLayout textLayout = NULL;
+ TableEmbWindow *ewPtr;
+ Tk_FontMetrics fm;
+ Tk_Font ellFont = NULL;
+ char *ellipsis = NULL;
+ int ellLen = 0, useEllLen = 0, ellEast = 0;
+
+ tablePtr->flags &= ~REDRAW_PENDING;
+ if ((tkwin == NULL) || !Tk_IsMapped(tkwin)) {
+ return;
+ }
+
+ boundW = Tk_Width(tkwin) - tablePtr->highlightWidth;
+ boundH = Tk_Height(tkwin) - tablePtr->highlightWidth;
+
+ /* Constrain drawable to not include highlight borders */
+ invalidX = MAX(tablePtr->highlightWidth, tablePtr->invalidX);
+ invalidY = MAX(tablePtr->highlightWidth, tablePtr->invalidY);
+ invalidWidth = MIN(tablePtr->invalidWidth, MAX(1, boundW-invalidX));
+ invalidHeight = MIN(tablePtr->invalidHeight, MAX(1, boundH-invalidY));
+
+ ipadx = tablePtr->ipadX;
+ ipady = tablePtr->ipadY;
+ padx = tablePtr->padX;
+ pady = tablePtr->padY;
+
+#ifndef WIN32
+ /*
+ * if we are using the slow drawing mode with a pixmap
+ * create the pixmap and adjust x && y for offset in pixmap
+ * FIX: Ignore slow mode for Win32 as the fast ClipRgn trick
+ * below does not work for bitmaps.
+ */
+ if (tablePtr->drawMode == DRAW_MODE_SLOW) {
+ window = Tk_GetPixmap(display, Tk_WindowId(tkwin),
+ invalidWidth, invalidHeight, Tk_Depth(tkwin));
+ } else
+#endif
+ window = Tk_WindowId(tkwin);
+#ifdef NO_XSETCLIP
+ clipWind = Tk_GetPixmap(display, window,
+ invalidWidth, invalidHeight, Tk_Depth(tkwin));
+#endif
+
+ /* set up the permanent tag styles */
+ entryPtr = Tcl_FindHashEntry(tablePtr->tagTable, "title");
+ titlePtr = (TableTag *) Tcl_GetHashValue(entryPtr);
+ entryPtr = Tcl_FindHashEntry(tablePtr->tagTable, "sel");
+ selPtr = (TableTag *) Tcl_GetHashValue(entryPtr);
+ entryPtr = Tcl_FindHashEntry(tablePtr->tagTable, "active");
+ activePtr = (TableTag *) Tcl_GetHashValue(entryPtr);
+ entryPtr = Tcl_FindHashEntry(tablePtr->tagTable, "flash");
+ flashPtr = (TableTag *) Tcl_GetHashValue(entryPtr);
+
+ /* We need to find out the true cell span, not considering spans */
+ tablePtr->flags |= AVOID_SPANS;
+ /* find out the cells represented by the invalid region */
+ TableWhatCell(tablePtr, invalidX, invalidY, &rowFrom, &colFrom);
+ TableWhatCell(tablePtr, invalidX+invalidWidth-1,
+ invalidY+invalidHeight-1, &rowTo, &colTo);
+ tablePtr->flags &= ~AVOID_SPANS;
+
+#ifdef DEBUG
+ tcl_dprintf(tablePtr->interp, "%d,%d => %d,%d",
+ rowFrom+tablePtr->rowOffset, colFrom+tablePtr->colOffset,
+ rowTo+tablePtr->rowOffset, colTo+tablePtr->colOffset);
+#endif
+
+ /*
+ * Initialize colTagsCache hash table to cache column tag names.
+ */
+ colTagsCache = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+ Tcl_InitHashTable(colTagsCache, TCL_ONE_WORD_KEYS);
+ /*
+ * Initialize drawnCache hash table to cache drawn cells.
+ * This is necessary to prevent spanning cells being drawn multiple times.
+ */
+ drawnCache = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+ Tcl_InitHashTable(drawnCache, TCL_STRING_KEYS);
+
+ /*
+ * Create the tag here. This will actually create a JoinTag
+ * That will handle the priority management of merging for us.
+ * We only need one allocated, and we'll reset it for each cell.
+ */
+ tagPtr = TableNewTag(tablePtr);
+
+ /* Cycle through the cells and display them */
+ for (row = rowFrom; row <= rowTo; row++) {
+ /*
+ * are we in the 'dead zone' between the
+ * title rows and the first displayed row
+ */
+ if (row < tablePtr->topRow && row >= tablePtr->titleRows) {
+ row = tablePtr->topRow;
+ }
+
+ /* Cache the row in user terms */
+ urow = row+tablePtr->rowOffset;
+
+ /* Get the row tag once for all iterations of col */
+ rowPtr = FindRowColTag(tablePtr, urow, ROW);
+
+ for (col = colFrom; col <= colTo; col++) {
+ activeCell = 0;
+ /*
+ * Adjust to first viewable column if we are in the 'dead zone'
+ * between the title cols and the first displayed column.
+ */
+ if (col < tablePtr->leftCol && col >= tablePtr->titleCols) {
+ col = tablePtr->leftCol;
+ }
+
+ /*
+ * Get the coordinates for the cell before possible rearrangement
+ * of row,col due to spanning cells
+ */
+ cellType = TableCellCoords(tablePtr, row, col,
+ &x, &y, &width, &height);
+ if (cellType == CELL_HIDDEN) {
+ /*
+ * width,height holds the real start row,col of the span.
+ * Put the use cell ref into a buffer for the hash lookups.
+ */
+ TableMakeArrayIndex(width, height, buf);
+ Tcl_CreateHashEntry(drawnCache, buf, &new);
+ if (!new) {
+ /* Not new in the entry, so it's already drawn */
+ continue;
+ }
+ hrow = row; hcol = col;
+ row = width-tablePtr->rowOffset;
+ col = height-tablePtr->colOffset;
+ TableCellVCoords(tablePtr, row, col,
+ &x, &y, &width, &height, 0);
+ /* We have to adjust the coords back onto the visual display */
+ urow = row+tablePtr->rowOffset;
+ rowPtr = FindRowColTag(tablePtr, urow, ROW);
+ }
+
+ /* Constrain drawn size to the visual boundaries */
+ if (width > boundW-x) { width = boundW-x; }
+ if (height > boundH-y) { height = boundH-y; }
+
+ /* Cache the col in user terms */
+ ucol = col+tablePtr->colOffset;
+
+ /* put the use cell ref into a buffer for the hash lookups */
+ TableMakeArrayIndex(urow, ucol, buf);
+ if (cellType != CELL_HIDDEN) {
+ Tcl_CreateHashEntry(drawnCache, buf, &new);
+ }
+
+ /*
+ * Make sure we start with a clean tag (set to table defaults).
+ */
+ TableResetTag(tablePtr, tagPtr);
+
+ /*
+ * Check to see if we have an embedded window in this cell.
+ */
+ entryPtr = Tcl_FindHashEntry(tablePtr->winTable, buf);
+ if (entryPtr != NULL) {
+ ewPtr = (TableEmbWindow *) Tcl_GetHashValue(entryPtr);
+
+ if (ewPtr->tkwin != NULL) {
+ /* Display embedded window instead of text */
+
+ /* if active, make it disabled to avoid
+ * unnecessary editing */
+ if ((tablePtr->flags & HAS_ACTIVE)
+ && row == tablePtr->activeRow
+ && col == tablePtr->activeCol) {
+ tablePtr->flags |= ACTIVE_DISABLED;
+ }
+
+ /*
+ * The EmbWinDisplay function may modify values in
+ * tagPtr, so reference those after this call.
+ */
+ EmbWinDisplay(tablePtr, window, ewPtr, tagPtr,
+ x, y, width, height);
+
+#ifndef WIN32
+ if (tablePtr->drawMode == DRAW_MODE_SLOW) {
+ /* Correctly adjust x && y with the offset */
+ x -= invalidX;
+ y -= invalidY;
+ }
+#endif
+
+ Tk_Fill3DRectangle(tkwin, window, tagPtr->bg, x, y, width,
+ height, 0, TK_RELIEF_FLAT);
+
+ /* border width for cell should now be properly set */
+ borders = TableGetTagBorders(tagPtr, &bd[0], &bd[1],
+ &bd[2], &bd[3]);
+ bd[4] = (bd[0] + bd[1])/2;
+ bd[5] = (bd[2] + bd[3])/2;
+
+ goto DrawBorder;
+ }
+ }
+
+ /*
+ * Don't draw what won't be seen.
+ * Embedded windows handle this in EmbWinDisplay.
+ */
+ if ((width <= 0) || (height <= 0)) { continue; }
+
+#ifndef WIN32
+ if (tablePtr->drawMode == DRAW_MODE_SLOW) {
+ /* Correctly adjust x && y with the offset */
+ x -= invalidX;
+ y -= invalidY;
+ }
+#endif
+
+ shouldInvert = 0;
+ /*
+ * Get the combined tag structure for the cell.
+ * First clear out a new tag structure that we will build in
+ * then add tags as we realize they belong.
+ *
+ * Tags have their own priorities which TableMergeTag will
+ * take into account when merging tags.
+ */
+
+ /*
+ * Merge colPtr if it exists
+ * let's see if we have the value cached already
+ * if not, run the findColTag routine and cache the value
+ */
+ entryPtr = Tcl_CreateHashEntry(colTagsCache, (char *)ucol, &new);
+ if (new) {
+ colPtr = FindRowColTag(tablePtr, ucol, COL);
+ Tcl_SetHashValue(entryPtr, colPtr);
+ } else {
+ colPtr = (TableTag *) Tcl_GetHashValue(entryPtr);
+ }
+ if (colPtr != (TableTag *) NULL) {
+ TableMergeTag(tablePtr, tagPtr, colPtr);
+ }
+ /* Merge rowPtr if it exists */
+ if (rowPtr != (TableTag *) NULL) {
+ TableMergeTag(tablePtr, tagPtr, rowPtr);
+ }
+ /* Am I in the titles */
+ if (row < tablePtr->titleRows || col < tablePtr->titleCols) {
+ TableMergeTag(tablePtr, tagPtr, titlePtr);
+ }
+ /* Does this have a cell tag */
+ entryPtr = Tcl_FindHashEntry(tablePtr->cellStyles, buf);
+ if (entryPtr != NULL) {
+ TableMergeTag(tablePtr, tagPtr,
+ (TableTag *) Tcl_GetHashValue(entryPtr));
+ }
+ /* is this cell active? */
+ if ((tablePtr->flags & HAS_ACTIVE) &&
+ (tablePtr->state == STATE_NORMAL) &&
+ row == tablePtr->activeRow && col == tablePtr->activeCol) {
+ if (tagPtr->state == STATE_DISABLED) {
+ tablePtr->flags |= ACTIVE_DISABLED;
+ } else {
+ TableMergeTag(tablePtr, tagPtr, activePtr);
+ activeCell = 1;
+ tablePtr->flags &= ~ACTIVE_DISABLED;
+ }
+ }
+ /* is this cell selected? */
+ if (Tcl_FindHashEntry(tablePtr->selCells, buf) != NULL) {
+ if (tablePtr->invertSelected && !activeCell) {
+ shouldInvert = 1;
+ } else {
+ TableMergeTag(tablePtr, tagPtr, selPtr);
+ }
+ }
+ /* if flash mode is on, is this cell flashing? */
+ if (tablePtr->flashMode &&
+ Tcl_FindHashEntry(tablePtr->flashCells, buf) != NULL) {
+ TableMergeTag(tablePtr, tagPtr, flashPtr);
+ }
+
+ if (shouldInvert) {
+ TableInvertTag(tagPtr);
+ }
+
+ /*
+ * Borders for cell should now be properly set
+ */
+ borders = TableGetTagBorders(tagPtr, &bd[0], &bd[1],
+ &bd[2], &bd[3]);
+ bd[4] = (bd[0] + bd[1])/2;
+ bd[5] = (bd[2] + bd[3])/2;
+
+ /*
+ * First fill in a blank rectangle.
+ */
+ Tk_Fill3DRectangle(tkwin, window, tagPtr->bg,
+ x, y, width, height, 0, TK_RELIEF_FLAT);
+
+ /*
+ * Correct the dimensions to enforce padding constraints
+ */
+ width -= bd[0] + bd[1] + (2 * padx);
+ height -= bd[2] + bd[3] + (2 * pady);
+
+ /*
+ * Don't draw what won't be seen, based on border constraints.
+ */
+ if ((width <= 0) || (height <= 0)) {
+ /*
+ * Re-Correct the dimensions before border drawing
+ */
+ width += bd[0] + bd[1] + (2 * padx);
+ height += bd[2] + bd[3] + (2 * pady);
+ goto DrawBorder;
+ }
+
+ /*
+ * If an image is in the tag, draw it
+ */
+ if (tagPtr->image != NULL) {
+ Tk_SizeOfImage(tagPtr->image, &itemW, &itemH);
+ /* Handle anchoring of image in cell space */
+ switch (tagPtr->anchor) {
+ case TK_ANCHOR_NW:
+ case TK_ANCHOR_W:
+ case TK_ANCHOR_SW: /* western position */
+ originX = itemX = 0;
+ break;
+ case TK_ANCHOR_N:
+ case TK_ANCHOR_S:
+ case TK_ANCHOR_CENTER: /* centered position */
+ itemX = MAX(0, (itemW - width) / 2);
+ originX = MAX(0, (width - itemW) / 2);
+ break;
+ default: /* eastern position */
+ itemX = MAX(0, itemW - width);
+ originX = MAX(0, width - itemW);
+ }
+ switch (tagPtr->anchor) {
+ case TK_ANCHOR_N:
+ case TK_ANCHOR_NE:
+ case TK_ANCHOR_NW: /* northern position */
+ originY = itemY = 0;
+ break;
+ case TK_ANCHOR_W:
+ case TK_ANCHOR_E:
+ case TK_ANCHOR_CENTER: /* centered position */
+ itemY = MAX(0, (itemH - height) / 2);
+ originY = MAX(0, (height - itemH) / 2);
+ break;
+ default: /* southern position */
+ itemY = MAX(0, itemH - height);
+ originY = MAX(0, height - itemH);
+ }
+ Tk_RedrawImage(tagPtr->image, itemX, itemY,
+ MIN(itemW, width-originX), MIN(itemH, height-originY),
+ window, x + originX + bd[0] + padx,
+ y + originY + bd[2] + pady);
+ /*
+ * If we don't want to display the text as well, then jump.
+ */
+ if (tagPtr->showtext == 0) {
+ /*
+ * Re-Correct the dimensions before border drawing
+ */
+ width += bd[0] + bd[1] + (2 * padx);
+ height += bd[2] + bd[3] + (2 * pady);
+ goto DrawBorder;
+ }
+ }
+
+ /*
+ * Get the GC for this particular blend of tags.
+ * This creates the GC if it never existed, otherwise it
+ * modifies the one we have, so we only need the one
+ */
+ TableGetGc(display, window, tagPtr, &tagGc);
+
+ /* if this is the active cell, use the buffer */
+ if (activeCell) {
+ string = tablePtr->activeBuf;
+ } else {
+ /* Is there a value in the cell? If so, draw it */
+ string = TableGetCellValue(tablePtr, urow, ucol);
+ }
+
+#ifdef TCL_UTF_MAX
+ /*
+ * We have to use strlen here because otherwise it stops
+ * at the first \x00 unicode char it finds (!= '\0'),
+ * although there can be more to the string than that
+ */
+ numBytes = Tcl_NumUtfChars(string, (int) strlen(string));
+#else
+ numBytes = strlen(string);
+#endif
+
+ /* If there is a string, show it */
+ if (activeCell || numBytes) {
+ register int x0 = x + bd[0] + padx;
+ register int y0 = y + bd[2] + pady;
+
+ /* get the dimensions of the string */
+ textLayout = Tk_ComputeTextLayout(tagPtr->tkfont,
+ string, numBytes,
+ (tagPtr->wrap > 0) ? width : 0, tagPtr->justify,
+ (tagPtr->multiline > 0) ? 0 : TK_IGNORE_NEWLINES,
+ &itemW, &itemH);
+
+ /*
+ * Set the origin coordinates of the string to draw using
+ * the anchor. origin represents the (x,y) coordinate of
+ * the lower left corner of the text box, relative to the
+ * internal (inside the border) window
+ */
+
+ /* set the X origin first */
+ switch (tagPtr->anchor) {
+ case TK_ANCHOR_NW:
+ case TK_ANCHOR_W:
+ case TK_ANCHOR_SW: /* western position */
+ originX = ipadx;
+ break;
+ case TK_ANCHOR_N:
+ case TK_ANCHOR_S:
+ case TK_ANCHOR_CENTER: /* centered position */
+ originX = (width - itemW) / 2;
+ break;
+ default: /* eastern position */
+ originX = width - itemW - ipadx;
+ }
+
+ /* then set the Y origin */
+ switch (tagPtr->anchor) {
+ case TK_ANCHOR_N:
+ case TK_ANCHOR_NE:
+ case TK_ANCHOR_NW: /* northern position */
+ originY = ipady;
+ break;
+ case TK_ANCHOR_W:
+ case TK_ANCHOR_E:
+ case TK_ANCHOR_CENTER: /* centered position */
+ originY = (height - itemH) / 2;
+ break;
+ default: /* southern position */
+ originY = height - itemH - ipady;
+ }
+
+ /*
+ * If this is the active cell and we are editing,
+ * ensure that the cursor will be displayed
+ */
+ if (activeCell) {
+ Tk_CharBbox(textLayout, tablePtr->icursor,
+ &cx, &cy, &cw, &ch);
+ /* we have to fudge with maxW because of odd width
+ * determination for newlines at the end of a line */
+ maxW = width - tablePtr->insertWidth
+ - (cx + MIN(tablePtr->charWidth, cw));
+ maxH = height - (cy + ch);
+ if (originX < bd[0] - cx) {
+ /* cursor off cell to the left */
+ /* use western positioning to cet cursor at left
+ * with slight variation to show some text */
+ originX = bd[0] - cx
+ + MIN(cx, width - tablePtr->insertWidth);
+ } else if (originX > maxW) {
+ /* cursor off cell to the right */
+ /* use eastern positioning to cet cursor at right */
+ originX = maxW;
+ }
+ if (originY < bd[2] - cy) {
+ /* cursor before top of cell */
+ /* use northern positioning to cet cursor at top */
+ originY = bd[2] - cy;
+ } else if (originY > maxH) {
+ /* cursor beyond bottom of cell */
+ /* use southern positioning to cet cursor at bottom */
+ originY = maxH;
+ }
+ tablePtr->activeTagPtr = tagPtr;
+ tablePtr->activeX = originX;
+ tablePtr->activeY = originY;
+ }
+
+ /*
+ * Use a clip rectangle only if necessary as it means
+ * updating the GC in the server which slows everything down.
+ * We can't fudge the width or height, just in case the user
+ * wanted empty pad space.
+ */
+ if ((originX < 0) || (originY < 0) ||
+ (originX+itemW > width) || (originY+itemH > height)) {
+ if (!activeCell
+ && (tagPtr->ellipsis != NULL)
+ && (tagPtr->wrap <= 0)
+ && (tagPtr->multiline <= 0)
+ ) {
+ /*
+ * Check which side to draw ellipsis on
+ */
+ switch (tagPtr->anchor) {
+ case TK_ANCHOR_NE:
+ case TK_ANCHOR_E:
+ case TK_ANCHOR_SE: /* eastern position */
+ ellEast = 0;
+ break;
+ default: /* western position */
+ ellEast = 1;
+ }
+ if ((ellipsis != tagPtr->ellipsis)
+ || (ellFont != tagPtr->tkfont)) {
+ /*
+ * Different ellipsis from last cached
+ */
+ ellFont = tagPtr->tkfont;
+ ellipsis = tagPtr->ellipsis;
+ ellLen = Tk_TextWidth(ellFont,
+ ellipsis, (int) strlen(ellipsis));
+ Tk_GetFontMetrics(tagPtr->tkfont, &fm);
+ }
+ useEllLen = MIN(ellLen, width);
+ } else {
+ ellEast = 0;
+ useEllLen = 0;
+ }
+
+ /*
+ * The text wants to overflow the boundaries of the
+ * displayed cell, so we must clip in some way
+ */
+#ifdef NO_XSETCLIP
+ /*
+ * This code is basically for the Macintosh.
+ * Copy the the current contents of the cell into the
+ * clipped window area. This keeps any fg/bg and image
+ * data intact.
+ * x0 - x == pad area
+ */
+ XCopyArea(display, window, clipWind, tagGc, x0, y0,
+ width, height, x0 - x, y0 - y);
+ /*
+ * Now draw into the cell space on the special window.
+ * Don't use x,y base offset for clipWind.
+ */
+ Tk_DrawTextLayout(display, clipWind, tagGc, textLayout,
+ x0 - x + originX, y0 - y + originY, 0, -1);
+
+ if (useEllLen) {
+ /*
+ * Recopy area the ellipse covers (not efficient)
+ */
+ XCopyArea(display, window, clipWind, tagGc,
+ x0 + (ellEast ? width - useEllLen : 0), y0,
+ useEllLen, height,
+ x0 - x + (ellEast ? width - useEllLen : 0),
+ y0 - y);
+ Tk_DrawChars(display, clipWind, tagGc, ellFont,
+ ellipsis, (int) strlen(ellipsis),
+ x0 - x + (ellEast ? width - useEllLen : 0),
+ y0 - y + originY + fm.ascent);
+ }
+ /*
+ * Now copy back only the area that we want the
+ * text to be drawn on.
+ */
+ XCopyArea(display, clipWind, window, tagGc,
+ x0 - x, y0 - y, width, height, x0, y0);
+#elif defined(WIN32)
+ /*
+ * This is evil, evil evil! but the XCopyArea
+ * doesn't work in all cases - Michael Teske.
+ * The general structure follows the comments below.
+ */
+ twdPtr = (TkWinDrawable *) window;
+ dc = GetDC(twdPtr->window.handle);
+
+ clipR = CreateRectRgn(x0 + (ellEast ? 0 : useEllLen), y0,
+ x0 + width - (ellEast ? useEllLen : 0), y0 + height);
+
+ SelectClipRgn(dc, clipR);
+ DeleteObject(clipR);
+ /* OffsetClipRgn(dc, 0, 0); */
+
+ Tk_DrawTextLayout(display, window, tagGc, textLayout,
+ x0 + originX, y0 + originY, 0, -1);
+
+ if (useEllLen) {
+ clipR = CreateRectRgn(x0, y0, x0 + width, y0 + height);
+ SelectClipRgn(dc, clipR);
+ DeleteObject(clipR);
+ Tk_DrawChars(display, window, tagGc, ellFont,
+ ellipsis, (int) strlen(ellipsis),
+ x0 + (ellEast? width-useEllLen : 0),
+ y0 + originY + fm.ascent);
+ }
+ SelectClipRgn(dc, NULL);
+ ReleaseDC(twdPtr->window.handle, dc);
+#else
+ /*
+ * Use an X clipping rectangle. The clipping is the
+ * rectangle just for the actual text space (to allow
+ * for empty padding space).
+ */
+ clipRect.x = x0 + (ellEast ? 0 : useEllLen);
+ clipRect.y = y0;
+ clipRect.width = width - (ellEast ? useEllLen : 0);
+ clipRect.height = height;
+ XSetClipRectangles(display, tagGc, 0, 0, &clipRect, 1,
+ Unsorted);
+ Tk_DrawTextLayout(display, window, tagGc, textLayout,
+ x0 + originX,
+ y0 + originY, 0, -1);
+ if (useEllLen) {
+ clipRect.x = x0;
+ clipRect.width = width;
+ XSetClipRectangles(display, tagGc, 0, 0, &clipRect, 1,
+ Unsorted);
+ Tk_DrawChars(display, window, tagGc, ellFont,
+ ellipsis, (int) strlen(ellipsis),
+ x0 + (ellEast? width-useEllLen : 0),
+ y0 + originY + fm.ascent);
+ }
+ XSetClipMask(display, tagGc, None);
+#endif
+ } else {
+ Tk_DrawTextLayout(display, window, tagGc, textLayout,
+ x0 + originX, y0 + originY, 0, -1);
+ }
+
+ /* if this is the active cell draw the cursor if it's on.
+ * this ignores clip rectangles. */
+ if (activeCell && (tablePtr->flags & CURSOR_ON) &&
+ (originY + cy + bd[2] + pady < height) &&
+ (originX + cx + bd[0] + padx -
+ (tablePtr->insertWidth / 2) >= 0)) {
+ /* make sure it will fit in the box */
+ maxW = MAX(0, originY + cy + bd[2] + pady);
+ maxH = MIN(ch, height - maxW + bd[2] + pady);
+ Tk_Fill3DRectangle(tkwin, window, tablePtr->insertBg,
+ x0 + originX + cx - (tablePtr->insertWidth/2),
+ y + maxW, tablePtr->insertWidth,
+ maxH, 0, TK_RELIEF_FLAT);
+ }
+ }
+
+ /*
+ * Re-Correct the dimensions before border drawing
+ */
+ width += bd[0] + bd[1] + (2 * padx);
+ height += bd[2] + bd[3] + (2 * pady);
+
+ DrawBorder:
+ /* Draw the 3d border on the pixmap correctly offset */
+ if (tablePtr->drawMode == DRAW_MODE_SINGLE) {
+ topGc = Tk_3DBorderGC(tkwin, tagPtr->bg, TK_3D_DARK_GC);
+ /* draw a line with single pixel width */
+ rect[0].x = x;
+ rect[0].y = y + height - 1;
+ rect[1].y = -height + 1;
+ rect[2].x = width - 1;
+ XDrawLines(display, window, topGc, rect, 3, CoordModePrevious);
+ } else if (tablePtr->drawMode == DRAW_MODE_FAST) {
+ /*
+ * This depicts a full 1 pixel border.
+ *
+ * Choose the GCs to get the best approximation
+ * to the desired drawing style.
+ */
+ switch(tagPtr->relief) {
+ case TK_RELIEF_FLAT:
+ topGc = bottomGc = Tk_3DBorderGC(tkwin, tagPtr->bg,
+ TK_3D_FLAT_GC);
+ break;
+ case TK_RELIEF_RAISED:
+ case TK_RELIEF_RIDGE:
+ topGc = Tk_3DBorderGC(tkwin, tagPtr->bg,
+ TK_3D_LIGHT_GC);
+ bottomGc = Tk_3DBorderGC(tkwin, tagPtr->bg,
+ TK_3D_DARK_GC);
+ break;
+ default: /* TK_RELIEF_SUNKEN TK_RELIEF_GROOVE */
+ bottomGc = Tk_3DBorderGC(tkwin, tagPtr->bg,
+ TK_3D_LIGHT_GC);
+ topGc = Tk_3DBorderGC(tkwin, tagPtr->bg,
+ TK_3D_DARK_GC);
+ break;
+ }
+
+ /* draw a line with single pixel width */
+ rect[0].x = x + width - 1;
+ rect[0].y = y;
+ rect[1].y = height - 1;
+ rect[2].x = -width + 1;
+ XDrawLines(display, window, bottomGc, rect, 3,
+ CoordModePrevious);
+ rect[0].x = x;
+ rect[0].y = y + height - 1;
+ rect[1].y = -height + 1;
+ rect[2].x = width - 1;
+ XDrawLines(display, window, topGc, rect, 3,
+ CoordModePrevious);
+ } else {
+ if (borders > 1) {
+ if (bd[0]) {
+ Tk_3DVerticalBevel(tkwin, window, tagPtr->bg,
+ x, y, bd[0], height,
+ 1 /* left side */, tagPtr->relief);
+ }
+ if (bd[1]) {
+ Tk_3DVerticalBevel(tkwin, window, tagPtr->bg,
+ x + width - bd[1], y, bd[1], height,
+ 0 /* right side */, tagPtr->relief);
+ }
+ if ((borders == 4) && bd[2]) {
+ Tk_3DHorizontalBevel(tkwin, window, tagPtr->bg,
+ x, y, width, bd[2],
+ 1, 1, 1 /* top */, tagPtr->relief);
+ }
+ if ((borders == 4) && bd[3]) {
+ Tk_3DHorizontalBevel(tkwin, window, tagPtr->bg,
+ x, y + height - bd[3], width, bd[3],
+ 0, 0, 0 /* bottom */, tagPtr->relief);
+ }
+ } else if (borders == 1) {
+ Tk_Draw3DRectangle(tkwin, window, tagPtr->bg, x, y,
+ width, height, bd[0], tagPtr->relief);
+ }
+ }
+
+ /* clean up the necessaries */
+ if (tagPtr == tablePtr->activeTagPtr) {
+ /*
+ * This means it was the activeCell with text displayed.
+ * We buffer the active tag for the 'activate' command.
+ */
+ tablePtr->activeTagPtr = TableNewTag(NULL);
+ memcpy((VOID *) tablePtr->activeTagPtr,
+ (VOID *) tagPtr, sizeof(TableTag));
+ }
+ if (textLayout) {
+ Tk_FreeTextLayout(textLayout);
+ textLayout = NULL;
+ }
+ if (cellType == CELL_HIDDEN) {
+ /* the last cell was a hidden one,
+ * rework row stuff back to normal */
+ row = hrow; col = hcol;
+ urow = row+tablePtr->rowOffset;
+ rowPtr = FindRowColTag(tablePtr, urow, ROW);
+ }
+ }
+ }
+ ckfree((char *) tagPtr);
+#ifdef NO_XSETCLIP
+ Tk_FreePixmap(display, clipWind);
+#endif
+
+ /* Take care of removing embedded windows that are no longer in view */
+ TableUndisplay(tablePtr);
+
+#ifndef WIN32
+ /* copy over and delete the pixmap if we are in slow mode */
+ if (tablePtr->drawMode == DRAW_MODE_SLOW) {
+ /* Get a default valued GC */
+ TableGetGc(display, window, &(tablePtr->defaultTag), &tagGc);
+ XCopyArea(display, window, Tk_WindowId(tkwin), tagGc, 0, 0,
+ (unsigned) invalidWidth, (unsigned) invalidHeight,
+ invalidX, invalidY);
+ Tk_FreePixmap(display, window);
+ window = Tk_WindowId(tkwin);
+ }
+#endif
+
+ /*
+ * If we are at the end of the table, clear the area after the last
+ * row/col. We discount spans here because we just need the coords
+ * for the area that would be the last physical cell.
+ */
+ tablePtr->flags |= AVOID_SPANS;
+ TableCellCoords(tablePtr, tablePtr->rows-1, tablePtr->cols-1,
+ &x, &y, &width, &height);
+ tablePtr->flags &= ~AVOID_SPANS;
+
+ /* This should occur before moving pixmap, but this simplifies things
+ *
+ * Could use Tk_Fill3DRectangle instead of XFillRectangle
+ * for best compatibility, and XClearArea could be used on Unix
+ * for best speed, so this is the compromise w/o #ifdef's
+ */
+ if (x+width < invalidX+invalidWidth) {
+ XFillRectangle(display, window,
+ Tk_3DBorderGC(tkwin, tablePtr->defaultTag.bg, TK_3D_FLAT_GC),
+ x+width, invalidY, (unsigned) invalidX+invalidWidth-x-width,
+ (unsigned) invalidHeight);
+ }
+
+ if (y+height < invalidY+invalidHeight) {
+ XFillRectangle(display, window,
+ Tk_3DBorderGC(tkwin, tablePtr->defaultTag.bg, TK_3D_FLAT_GC),
+ invalidX, y+height, (unsigned) invalidWidth,
+ (unsigned) invalidY+invalidHeight-y-height);
+ }
+
+ if (tagGc != NULL) {
+ TableFreeGc(display, tagGc);
+ }
+ TableRedrawHighlight(tablePtr);
+ /*
+ * Free the hash table used to cache evaluations.
+ */
+ Tcl_DeleteHashTable(colTagsCache);
+ ckfree((char *) (colTagsCache));
+ Tcl_DeleteHashTable(drawnCache);
+ ckfree((char *) (drawnCache));
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableInvalidate --
+ * Invalidates a rectangle and adds it to the total invalid rectangle
+ * waiting to be redrawn. If the INV_FORCE flag bit is set,
+ * it does an update instantly else waits until Tk is idle.
+ *
+ * Results:
+ * Will schedule table (re)display.
+ *
+ * Side effects:
+ * None
+ *
+ *----------------------------------------------------------------------
+ */
+void
+TableInvalidate(Table * tablePtr, int x, int y,
+ int w, int h, int flags)
+{
+ Tk_Window tkwin = tablePtr->tkwin;
+ int hl = tablePtr->highlightWidth;
+ int height = Tk_Height(tkwin);
+ int width = Tk_Width(tkwin);
+
+ /*
+ * Make sure that the window hasn't been destroyed already.
+ * Avoid allocating 0 sized pixmaps which would be fatal,
+ * and check if rectangle is even on the screen.
+ */
+ if ((tkwin == NULL)
+ || (w <= 0) || (h <= 0) || (x > width) || (y > height)) {
+ return;
+ }
+
+ /* If not even mapped, wait for the remap to redraw all */
+ if (!Tk_IsMapped(tkwin)) {
+ tablePtr->flags |= REDRAW_ON_MAP;
+ return;
+ }
+
+ /*
+ * If no pending updates exist, then replace the rectangle.
+ * Otherwise find the bounding rectangle.
+ */
+ if ((flags & INV_HIGHLIGHT) &&
+ (x < hl || y < hl || x+w >= width-hl || y+h >= height-hl)) {
+ tablePtr->flags |= REDRAW_BORDER;
+ }
+
+ if (tablePtr->flags & REDRAW_PENDING) {
+ tablePtr->invalidWidth = MAX(x + w,
+ tablePtr->invalidX+tablePtr->invalidWidth);
+ tablePtr->invalidHeight = MAX(y + h,
+ tablePtr->invalidY+tablePtr->invalidHeight);
+ if (tablePtr->invalidX > x) tablePtr->invalidX = x;
+ if (tablePtr->invalidY > y) tablePtr->invalidY = y;
+ tablePtr->invalidWidth -= tablePtr->invalidX;
+ tablePtr->invalidHeight -= tablePtr->invalidY;
+ /* Do we want to force this update out? */
+ if (flags & INV_FORCE) {
+ Tcl_CancelIdleCall(TableDisplay, (ClientData) tablePtr);
+ TableDisplay((ClientData) tablePtr);
+ }
+ } else {
+ tablePtr->invalidX = x;
+ tablePtr->invalidY = y;
+ tablePtr->invalidWidth = w;
+ tablePtr->invalidHeight = h;
+ if (flags & INV_FORCE) {
+ TableDisplay((ClientData) tablePtr);
+ } else {
+ tablePtr->flags |= REDRAW_PENDING;
+ Tcl_DoWhenIdle(TableDisplay, (ClientData) tablePtr);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableFlashEvent --
+ * Called when the flash timer goes off.
+ *
+ * Results:
+ * Decrements all the entries in the hash table and invalidates
+ * any cells that expire, deleting them from the table. If the
+ * table is now empty, stops the timer, else reenables it.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+TableFlashEvent(ClientData clientdata)
+{
+ Table *tablePtr = (Table *) clientdata;
+ Tcl_HashEntry *entryPtr;
+ Tcl_HashSearch search;
+ int entries, count, row, col;
+
+ entries = 0;
+ for (entryPtr = Tcl_FirstHashEntry(tablePtr->flashCells, &search);
+ entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&search)) {
+ count = (int) Tcl_GetHashValue(entryPtr);
+ if (--count <= 0) {
+ /* get the cell address and invalidate that region only */
+ TableParseArrayIndex(&row, &col,
+ Tcl_GetHashKey(tablePtr->flashCells, entryPtr));
+
+ /* delete the entry from the table */
+ Tcl_DeleteHashEntry(entryPtr);
+
+ TableRefresh(tablePtr, row-tablePtr->rowOffset,
+ col-tablePtr->colOffset, CELL);
+ } else {
+ Tcl_SetHashValue(entryPtr, (ClientData) count);
+ entries++;
+ }
+ }
+
+ /* do I need to restart the timer */
+ if (entries && tablePtr->flashMode) {
+ tablePtr->flashTimer = Tcl_CreateTimerHandler(250, TableFlashEvent,
+ (ClientData) tablePtr);
+ } else {
+ tablePtr->flashTimer = 0;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableAddFlash --
+ * Adds a flash on cell row,col (real coords) with the default timeout
+ * if flashing is enabled and flashtime > 0.
+ *
+ * Results:
+ * Cell will flash.
+ *
+ * Side effects:
+ * Will start flash timer if it didn't exist.
+ *
+ *----------------------------------------------------------------------
+ */
+void
+TableAddFlash(Table *tablePtr, int row, int col)
+{
+ char buf[INDEX_BUFSIZE];
+ int dummy;
+ Tcl_HashEntry *entryPtr;
+
+ if (!tablePtr->flashMode || tablePtr->flashTime < 1) {
+ return;
+ }
+
+ /* create the array index in user coords */
+ TableMakeArrayIndex(row+tablePtr->rowOffset, col+tablePtr->colOffset, buf);
+
+ /* add the flash to the hash table */
+ entryPtr = Tcl_CreateHashEntry(tablePtr->flashCells, buf, &dummy);
+ Tcl_SetHashValue(entryPtr, tablePtr->flashTime);
+
+ /* now set the timer if it's not already going and invalidate the area */
+ if (tablePtr->flashTimer == NULL) {
+ tablePtr->flashTimer = Tcl_CreateTimerHandler(250, TableFlashEvent,
+ (ClientData) tablePtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableSetActiveIndex --
+ * Sets the "active" index of the associated array to the current
+ * value of the active buffer.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Traces on the array can cause side effects.
+ *
+ *----------------------------------------------------------------------
+ */
+void
+TableSetActiveIndex(register Table *tablePtr)
+{
+ if (tablePtr->arrayVar) {
+ tablePtr->flags |= SET_ACTIVE;
+ Tcl_SetVar2(tablePtr->interp, tablePtr->arrayVar, "active",
+ tablePtr->activeBuf, TCL_GLOBAL_ONLY);
+ tablePtr->flags &= ~SET_ACTIVE;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableGetActiveBuf --
+ * Get the current selection into the buffer and mark it as unedited.
+ * Set the position to the end of the string.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * tablePtr->activeBuf will change.
+ *
+ *----------------------------------------------------------------------
+ */
+void
+TableGetActiveBuf(register Table *tablePtr)
+{
+ char *data = "";
+
+ if (tablePtr->flags & HAS_ACTIVE) {
+ data = TableGetCellValue(tablePtr,
+ tablePtr->activeRow+tablePtr->rowOffset,
+ tablePtr->activeCol+tablePtr->colOffset);
+ }
+
+ if (STREQ(tablePtr->activeBuf, data)) {
+ /* this forced SetActiveIndex is necessary if we change array vars and
+ * they happen to have these cells equal, we won't properly set the
+ * active index for the new array var unless we do this here */
+ TableSetActiveIndex(tablePtr);
+ return;
+ }
+ /* is the buffer long enough */
+ tablePtr->activeBuf = (char *)ckrealloc(tablePtr->activeBuf,
+ strlen(data)+1);
+ strcpy(tablePtr->activeBuf, data);
+ TableGetIcursor(tablePtr, "end", (int *)0);
+ tablePtr->flags &= ~TEXT_CHANGED;
+ TableSetActiveIndex(tablePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableVarProc --
+ * This is the trace procedure associated with the Tcl array. No
+ * validation will occur here because this only triggers when the
+ * array value is directly set, and we can't maintain the old value.
+ *
+ * Results:
+ * Invalidates changed cell.
+ *
+ * Side effects:
+ * Creates/Updates entry in the cache if we are caching.
+ *
+ *----------------------------------------------------------------------
+ */
+static char *
+TableVarProc(clientData, interp, name, index, flags)
+ ClientData clientData; /* Information about table. */
+ Tcl_Interp *interp; /* Interpreter containing variable. */
+ char *name; /* Not used. */
+ char *index; /* Not used. */
+ int flags; /* Information about what happened. */
+{
+ Table *tablePtr = (Table *) clientData;
+ int row, col, update = 1;
+
+ /* This is redundant, as the name should always == arrayVar */
+ name = tablePtr->arrayVar;
+
+ /* is this the whole var being destroyed or just one cell being deleted */
+ if ((flags & TCL_TRACE_UNSETS) && index == NULL) {
+ /* if this isn't the interpreter being destroyed reinstate the trace */
+ if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) {
+ Tcl_SetVar2(interp, name, TEST_KEY, "", TCL_GLOBAL_ONLY);
+ Tcl_UnsetVar2(interp, name, TEST_KEY, TCL_GLOBAL_ONLY);
+ Tcl_ResetResult(interp);
+
+ /* set a trace on the variable */
+ Tcl_TraceVar(interp, name,
+ TCL_TRACE_WRITES | TCL_TRACE_UNSETS | TCL_GLOBAL_ONLY,
+ (Tcl_VarTraceProc *)TableVarProc, (ClientData) tablePtr);
+
+ /* only do the following if arrayVar is our data source */
+ if (tablePtr->dataSource & DATA_ARRAY) {
+ /* clear the selection buffer */
+ TableGetActiveBuf(tablePtr);
+ /* flush any cache */
+ Table_ClearHashTable(tablePtr->cache);
+ Tcl_InitHashTable(tablePtr->cache, TCL_STRING_KEYS);
+ /* and invalidate the table */
+ TableInvalidateAll(tablePtr, 0);
+ }
+ }
+ return (char *)NULL;
+ }
+ /* only continue if arrayVar is our data source */
+ if (!(tablePtr->dataSource & DATA_ARRAY)) {
+ return (char *)NULL;
+ }
+ /* get the cell address and invalidate that region only.
+ * Make sure that it is a valid cell address. */
+ if (STREQ("active", index)) {
+ if (tablePtr->flags & SET_ACTIVE) {
+ /* If we are already setting the active cell, the update
+ * will occur in other code */
+ update = 0;
+ } else {
+ /* modified TableGetActiveBuf */
+ CONST char *data = "";
+
+ row = tablePtr->activeRow;
+ col = tablePtr->activeCol;
+ if (tablePtr->flags & HAS_ACTIVE)
+ data = Tcl_GetVar2(interp, name, index, TCL_GLOBAL_ONLY);
+ if (!data) data = "";
+
+ if (STREQ(tablePtr->activeBuf, data)) {
+ return (char *)NULL;
+ }
+ tablePtr->activeBuf = (char *)ckrealloc(tablePtr->activeBuf,
+ strlen(data)+1);
+ strcpy(tablePtr->activeBuf, data);
+ /* set cursor to the last char */
+ TableGetIcursor(tablePtr, "end", (int *)0);
+ tablePtr->flags |= TEXT_CHANGED;
+ }
+ } else if (TableParseArrayIndex(&row, &col, index) == 2) {
+ char buf[INDEX_BUFSIZE];
+
+ /* Make sure it won't trigger on array(2,3extrastuff) */
+ TableMakeArrayIndex(row, col, buf);
+ if (strcmp(buf, index)) {
+ return (char *)NULL;
+ }
+ if (tablePtr->caching) {
+ Tcl_HashEntry *entryPtr;
+ int new;
+ char *val, *data;
+
+ entryPtr = Tcl_CreateHashEntry(tablePtr->cache, buf, &new);
+ if (!new) {
+ data = (char *) Tcl_GetHashValue(entryPtr);
+ if (data) { ckfree(data); }
+ }
+ data = (char *) Tcl_GetVar2(interp, name, index, TCL_GLOBAL_ONLY);
+ if (data && *data != '\0') {
+ val = (char *)ckalloc(strlen(data)+1);
+ strcpy(val, data);
+ } else {
+ val = NULL;
+ }
+ Tcl_SetHashValue(entryPtr, val);
+ }
+ /* convert index to real coords */
+ row -= tablePtr->rowOffset;
+ col -= tablePtr->colOffset;
+ /* did the active cell just update */
+ if (row == tablePtr->activeRow && col == tablePtr->activeCol) {
+ TableGetActiveBuf(tablePtr);
+ }
+ /* Flash the cell */
+ TableAddFlash(tablePtr, row, col);
+ } else {
+ return (char *)NULL;
+ }
+
+ if (update) {
+ TableRefresh(tablePtr, row, col, CELL);
+ }
+
+ return (char *)NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableGeometryRequest --
+ * This procedure is invoked to request a new geometry from Tk.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Geometry information is updated and a new requested size is
+ * registered for the widget. Internal border info is also set.
+ *
+ *----------------------------------------------------------------------
+ */
+void
+TableGeometryRequest(tablePtr)
+ register Table *tablePtr;
+{
+ int x, y;
+
+ /* Do the geometry request
+ * If -width #cols was not specified or it is greater than the real
+ * number of cols, use maxWidth as a lower bound, with the other lower
+ * bound being the upper bound of the window's user-set width and the
+ * value of -maxwidth set by the programmer
+ * Vice versa for rows/height
+ */
+ x = MIN((tablePtr->maxReqCols==0 || tablePtr->maxReqCols > tablePtr->cols)?
+ tablePtr->maxWidth : tablePtr->colStarts[tablePtr->maxReqCols],
+ tablePtr->maxReqWidth) + 2*tablePtr->highlightWidth;
+ y = MIN((tablePtr->maxReqRows==0 || tablePtr->maxReqRows > tablePtr->rows)?
+ tablePtr->maxHeight : tablePtr->rowStarts[tablePtr->maxReqRows],
+ tablePtr->maxReqHeight) + 2*tablePtr->highlightWidth;
+ Tk_GeometryRequest(tablePtr->tkwin, x, y);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableAdjustActive --
+ * This procedure is called by AdjustParams and CMD_ACTIVATE to
+ * move the active cell.
+ *
+ * Results:
+ * Old and new active cell indices will be invalidated.
+ *
+ * Side effects:
+ * If the old active cell index was edited, it will be saved.
+ * The active buffer will be updated.
+ *
+ *----------------------------------------------------------------------
+ */
+void
+TableAdjustActive(tablePtr)
+ register Table *tablePtr; /* Widget record for table */
+{
+ if (tablePtr->flags & HAS_ACTIVE) {
+ /*
+ * Make sure the active cell has a reasonable real index
+ */
+ CONSTRAIN(tablePtr->activeRow, 0, tablePtr->rows-1);
+ CONSTRAIN(tablePtr->activeCol, 0, tablePtr->cols-1);
+ }
+
+ /*
+ * Check the new value of active cell against the original,
+ * Only invalidate if it changed.
+ */
+ if (tablePtr->oldActRow == tablePtr->activeRow &&
+ tablePtr->oldActCol == tablePtr->activeCol) {
+ return;
+ }
+
+ if (tablePtr->oldActRow >= 0 && tablePtr->oldActCol >= 0) {
+ /*
+ * Set the value of the old active cell to the active buffer
+ * SetCellValue will check if the value actually changed
+ */
+ if (tablePtr->flags & TEXT_CHANGED) {
+ /* WARNING an outside trace will be triggered here and if it
+ * calls something that causes TableAdjustParams to be called
+ * again, we are in data consistency trouble */
+ /* HACK - turn TEXT_CHANGED off now to possibly avoid the
+ * above data inconsistency problem. */
+ tablePtr->flags &= ~TEXT_CHANGED;
+ TableSetCellValue(tablePtr,
+ tablePtr->oldActRow + tablePtr->rowOffset,
+ tablePtr->oldActCol + tablePtr->colOffset,
+ tablePtr->activeBuf);
+ }
+ /*
+ * Invalidate the old active cell
+ */
+ TableRefresh(tablePtr, tablePtr->oldActRow, tablePtr->oldActCol, CELL);
+ }
+
+ /*
+ * Store the new active cell value into the active buffer
+ */
+ TableGetActiveBuf(tablePtr);
+
+ /*
+ * Invalidate the new active cell
+ */
+ TableRefresh(tablePtr, tablePtr->activeRow, tablePtr->activeCol, CELL);
+
+ /*
+ * Cache the old active row/col for the next time this is called
+ */
+ tablePtr->oldActRow = tablePtr->activeRow;
+ tablePtr->oldActCol = tablePtr->activeCol;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableAdjustParams --
+ * Calculate the row and column starts. Adjusts the topleft corner
+ * variable to keep it within the screen range, out of the titles
+ * and keep the screen full make sure the selected cell is in the
+ * visible area checks to see if the top left cell has changed at
+ * all and invalidates the table if it has.
+ *
+ * Results:
+ * None.
+ *
+ * Side Effects:
+ * Number of rows can change if -rowstretchmode == fill.
+ * topRow && leftCol can change to fit display.
+ * activeRow/Col can change to ensure it is a valid cell.
+ *
+ *----------------------------------------------------------------------
+ */
+void
+TableAdjustParams(register Table *tablePtr)
+{
+ int topRow, leftCol, row, col, total, i, value, x, y, width, height,
+ w, h, hl, px, py, recalc, bd[4],
+ diff, unpreset, lastUnpreset, pad, lastPad, numPixels,
+ defColWidth, defRowHeight;
+ Tcl_HashEntry *entryPtr;
+
+ /*
+ * Cache some values for many upcoming calculations
+ */
+ hl = tablePtr->highlightWidth;
+ w = Tk_Width(tablePtr->tkwin) - (2 * hl);
+ h = Tk_Height(tablePtr->tkwin) - (2 * hl);
+ TableGetTagBorders(&(tablePtr->defaultTag),
+ &bd[0], &bd[1], &bd[2], &bd[3]);
+ px = bd[0] + bd[1] + (2 * tablePtr->padX);
+ py = bd[2] + bd[3] + (2 * tablePtr->padY);
+
+ /*
+ * Account for whether default dimensions are in chars (>0) or
+ * pixels (<=0). Border and Pad space is added in here for convenience.
+ *
+ * When a value in pixels is specified, we take that exact amount,
+ * not adding in padding.
+ */
+ if (tablePtr->defColWidth > 0) {
+ defColWidth = tablePtr->charWidth * tablePtr->defColWidth + px;
+ } else {
+ defColWidth = -(tablePtr->defColWidth);
+ }
+ if (tablePtr->defRowHeight > 0) {
+ defRowHeight = tablePtr->charHeight * tablePtr->defRowHeight + py;
+ } else {
+ defRowHeight = -(tablePtr->defRowHeight);
+ }
+
+ /*
+ * Set up the arrays to hold the col pixels and starts.
+ * ckrealloc was fixed in 8.2.1 to handle NULLs, so we can't rely on it.
+ */
+ if (tablePtr->colPixels) ckfree((char *) tablePtr->colPixels);
+ tablePtr->colPixels = (int *) ckalloc(tablePtr->cols * sizeof(int));
+ if (tablePtr->colStarts) ckfree((char *) tablePtr->colStarts);
+ tablePtr->colStarts = (int *) ckalloc((tablePtr->cols+1) * sizeof(int));
+
+ /*
+ * Get all the preset columns and set their widths
+ */
+ lastUnpreset = 0;
+ numPixels = 0;
+ unpreset = 0;
+ for (i = 0; i < tablePtr->cols; i++) {
+ entryPtr = Tcl_FindHashEntry(tablePtr->colWidths, (char *) i);
+ if (entryPtr == NULL) {
+ tablePtr->colPixels[i] = -1;
+ unpreset++;
+ lastUnpreset = i;
+ } else {
+ value = (int) Tcl_GetHashValue(entryPtr);
+ if (value > 0) {
+ tablePtr->colPixels[i] = value * tablePtr->charWidth + px;
+ } else {
+ /*
+ * When a value in pixels is specified, we take that exact
+ * amount, not adding in pad or border values.
+ */
+ tablePtr->colPixels[i] = -value;
+ }
+ numPixels += tablePtr->colPixels[i];
+ }
+ }
+
+ /*
+ * Work out how much to pad each col depending on the mode.
+ */
+ diff = w - numPixels - (unpreset * defColWidth);
+ total = 0;
+
+ /*
+ * Now do the padding and calculate the column starts.
+ * Diff lower than 0 means we can't see the entire set of columns,
+ * thus no special stretching will occur & we optimize the calculation.
+ */
+ if (diff <= 0) {
+ for (i = 0; i < tablePtr->cols; i++) {
+ if (tablePtr->colPixels[i] == -1) {
+ tablePtr->colPixels[i] = defColWidth;
+ }
+ tablePtr->colStarts[i] = total;
+ total += tablePtr->colPixels[i];
+ }
+ } else {
+ switch (tablePtr->colStretch) {
+ case STRETCH_MODE_NONE:
+ pad = 0;
+ lastPad = 0;
+ break;
+ case STRETCH_MODE_UNSET:
+ if (unpreset == 0) {
+ pad = 0;
+ lastPad = 0;
+ } else {
+ pad = diff / unpreset;
+ lastPad = diff - pad * (unpreset - 1);
+ }
+ break;
+ case STRETCH_MODE_LAST:
+ pad = 0;
+ lastPad = diff;
+ lastUnpreset = tablePtr->cols - 1;
+ break;
+ default: /* STRETCH_MODE_ALL, but also FILL for cols */
+ pad = diff / tablePtr->cols;
+ /* force it to be applied to the last column too */
+ lastUnpreset = tablePtr->cols - 1;
+ lastPad = diff - pad * lastUnpreset;
+ }
+
+ for (i = 0; i < tablePtr->cols; i++) {
+ if (tablePtr->colPixels[i] == -1) {
+ tablePtr->colPixels[i] = defColWidth
+ + ((i == lastUnpreset) ? lastPad : pad);
+ } else if (tablePtr->colStretch == STRETCH_MODE_ALL) {
+ tablePtr->colPixels[i] += (i == lastUnpreset) ? lastPad : pad;
+ }
+ tablePtr->colStarts[i] = total;
+ total += tablePtr->colPixels[i];
+ }
+ }
+ tablePtr->colStarts[i] = tablePtr->maxWidth = total;
+
+ /*
+ * The 'do' loop is only necessary for rows because of FILL mode
+ */
+ recalc = 0;
+ do {
+ /* Set up the arrays to hold the row pixels and starts */
+ /* FIX - this can be moved outside 'do' if you check >row size */
+ if (tablePtr->rowPixels) ckfree((char *) tablePtr->rowPixels);
+ tablePtr->rowPixels = (int *) ckalloc(tablePtr->rows * sizeof(int));
+
+ /* get all the preset rows and set their heights */
+ lastUnpreset = 0;
+ numPixels = 0;
+ unpreset = 0;
+ for (i = 0; i < tablePtr->rows; i++) {
+ entryPtr = Tcl_FindHashEntry(tablePtr->rowHeights, (char *) i);
+ if (entryPtr == NULL) {
+ tablePtr->rowPixels[i] = -1;
+ unpreset++;
+ lastUnpreset = i;
+ } else {
+ value = (int) Tcl_GetHashValue(entryPtr);
+ if (value > 0) {
+ tablePtr->rowPixels[i] = value * tablePtr->charHeight + py;
+ } else {
+ /*
+ * When a value in pixels is specified, we take that exact
+ * amount, not adding in pad or border values.
+ */
+ tablePtr->rowPixels[i] = -value;
+ }
+ numPixels += tablePtr->rowPixels[i];
+ }
+ }
+
+ /* work out how much to pad each row depending on the mode */
+ diff = h - numPixels - (unpreset * defRowHeight);
+ switch(tablePtr->rowStretch) {
+ case STRETCH_MODE_NONE:
+ pad = 0;
+ lastPad = 0;
+ break;
+ case STRETCH_MODE_UNSET:
+ if (unpreset == 0) {
+ pad = 0;
+ lastPad = 0;
+ } else {
+ pad = MAX(0,diff) / unpreset;
+ lastPad = MAX(0,diff) - pad * (unpreset - 1);
+ }
+ break;
+ case STRETCH_MODE_LAST:
+ pad = 0;
+ lastPad = MAX(0,diff);
+ /* force it to be applied to the last column too */
+ lastUnpreset = tablePtr->rows - 1;
+ break;
+ case STRETCH_MODE_FILL:
+ pad = 0;
+ lastPad = diff;
+ if (diff && !recalc) {
+ tablePtr->rows += (diff/defRowHeight);
+ if (diff < 0 && tablePtr->rows <= 0) {
+ tablePtr->rows = 1;
+ }
+ lastUnpreset = tablePtr->rows - 1;
+ recalc = 1;
+ continue;
+ } else {
+ lastUnpreset = tablePtr->rows - 1;
+ recalc = 0;
+ }
+ break;
+ default: /* STRETCH_MODE_ALL */
+ pad = MAX(0,diff) / tablePtr->rows;
+ /* force it to be applied to the last column too */
+ lastUnpreset = tablePtr->rows - 1;
+ lastPad = MAX(0,diff) - pad * lastUnpreset;
+ }
+ } while (recalc);
+
+ if (tablePtr->rowStarts) ckfree((char *) tablePtr->rowStarts);
+ tablePtr->rowStarts = (int *) ckalloc((tablePtr->rows+1)*sizeof(int));
+ /*
+ * Now do the padding and calculate the row starts
+ */
+ total = 0;
+ for (i = 0; i < tablePtr->rows; i++) {
+ if (tablePtr->rowPixels[i] == -1) {
+ tablePtr->rowPixels[i] = defRowHeight
+ + ((i==lastUnpreset)?lastPad:pad);
+ } else if (tablePtr->rowStretch == STRETCH_MODE_ALL) {
+ tablePtr->rowPixels[i] += (i==lastUnpreset)?lastPad:pad;
+ }
+ /* calculate the start of each row */
+ tablePtr->rowStarts[i] = total;
+ total += tablePtr->rowPixels[i];
+ }
+ tablePtr->rowStarts[i] = tablePtr->maxHeight = total;
+
+ /*
+ * Make sure the top row and col have reasonable real indices
+ */
+ CONSTRAIN(tablePtr->topRow, tablePtr->titleRows, tablePtr->rows-1);
+ CONSTRAIN(tablePtr->leftCol, tablePtr->titleCols, tablePtr->cols-1);
+
+ /*
+ * If we don't have the info, don't bother to fix up the other parameters
+ */
+ if (Tk_WindowId(tablePtr->tkwin) == None) {
+ tablePtr->oldTopRow = tablePtr->oldLeftCol = -1;
+ return;
+ }
+
+ topRow = tablePtr->topRow;
+ leftCol = tablePtr->leftCol;
+ w += hl;
+ h += hl;
+ /*
+ * If we use this value of topRow, will we fill the window?
+ * if not, decrease it until we will, or until it gets to titleRows
+ * make sure we don't cut off the bottom row
+ */
+ for (; topRow > tablePtr->titleRows; topRow--) {
+ if ((tablePtr->maxHeight-(tablePtr->rowStarts[topRow-1] -
+ tablePtr->rowStarts[tablePtr->titleRows])) > h) {
+ break;
+ }
+ }
+ /*
+ * If we use this value of topCol, will we fill the window?
+ * if not, decrease it until we will, or until it gets to titleCols
+ * make sure we don't cut off the left column
+ */
+ for (; leftCol > tablePtr->titleCols; leftCol--) {
+ if ((tablePtr->maxWidth-(tablePtr->colStarts[leftCol-1] -
+ tablePtr->colStarts[tablePtr->titleCols])) > w) {
+ break;
+ }
+ }
+
+ tablePtr->topRow = topRow;
+ tablePtr->leftCol = leftCol;
+
+ /*
+ * Now work out where the bottom right is for scrollbar update and to test
+ * for one last stretch. Avoid the confusion that spans could cause for
+ * determining the last cell dimensions.
+ */
+ tablePtr->flags |= AVOID_SPANS;
+ TableGetLastCell(tablePtr, &row, &col);
+ TableCellVCoords(tablePtr, row, col, &x, &y, &width, &height, 0);
+ tablePtr->flags &= ~AVOID_SPANS;
+
+ /*
+ * Do we have scrollbars, if so, calculate and call the TCL functions In
+ * order to get the scrollbar to be completely full when the whole screen
+ * is shown and there are titles, we have to arrange for the scrollbar
+ * range to be 0 -> rows-titleRows etc. This leads to the position
+ * setting methods, toprow and leftcol, being relative to the titles, not
+ * absolute row and column numbers.
+ */
+ if (tablePtr->yScrollCmd != NULL || tablePtr->xScrollCmd != NULL) {
+ Tcl_Interp *interp = tablePtr->interp;
+ char buf[INDEX_BUFSIZE];
+ double first, last;
+
+ /*
+ * We must hold onto the interpreter because the data referred to at
+ * tablePtr might be freed as a result of the call to Tcl_VarEval.
+ */
+ Tcl_Preserve((ClientData) interp);
+
+ /* Do we have a Y-scrollbar and rows to scroll? */
+ if (tablePtr->yScrollCmd != NULL) {
+ if (row < tablePtr->titleRows) {
+ first = 0;
+ last = 1;
+ } else {
+ diff = tablePtr->rowStarts[tablePtr->titleRows];
+ last = (double) (tablePtr->rowStarts[tablePtr->rows]-diff);
+ if (last <= 0.0) {
+ first = 0;
+ last = 1;
+ } else {
+ first = (tablePtr->rowStarts[topRow]-diff) / last;
+ last = (height+tablePtr->rowStarts[row]-diff) / last;
+ }
+ }
+ sprintf(buf, " %g %g", first, last);
+ if (Tcl_VarEval(interp, tablePtr->yScrollCmd,
+ buf, (char *)NULL) != TCL_OK) {
+ Tcl_AddErrorInfo(interp,
+ "\n\t(vertical scrolling command executed by table)");
+ Tcl_BackgroundError(interp);
+ }
+ }
+ /* Do we have a X-scrollbar and cols to scroll? */
+ if (tablePtr->xScrollCmd != NULL) {
+ if (col < tablePtr->titleCols) {
+ first = 0;
+ last = 1;
+ } else {
+ diff = tablePtr->colStarts[tablePtr->titleCols];
+ last = (double) (tablePtr->colStarts[tablePtr->cols]-diff);
+ if (last <= 0.0) {
+ first = 0;
+ last = 1;
+ } else {
+ first = (tablePtr->colStarts[leftCol]-diff) / last;
+ last = (width+tablePtr->colStarts[col]-diff) / last;
+ }
+ }
+ sprintf(buf, " %g %g", first, last);
+ if (Tcl_VarEval(interp, tablePtr->xScrollCmd,
+ buf, (char *)NULL) != TCL_OK) {
+ Tcl_AddErrorInfo(interp,
+ "\n\t(horizontal scrolling command executed by table)");
+ Tcl_BackgroundError(interp);
+ }
+ }
+
+ Tcl_Release((ClientData) interp);
+ }
+
+ /*
+ * Adjust the last row/col to fill empty space if it is visible.
+ * Do this after setting the scrollbars to not upset its calculations.
+ */
+ if (row == tablePtr->rows-1 && tablePtr->rowStretch != STRETCH_MODE_NONE) {
+ diff = h-(y+height);
+ if (diff > 0) {
+ tablePtr->rowPixels[tablePtr->rows-1] += diff;
+ tablePtr->rowStarts[tablePtr->rows] += diff;
+ }
+ }
+ if (col == tablePtr->cols-1 && tablePtr->colStretch != STRETCH_MODE_NONE) {
+ diff = w-(x+width);
+ if (diff > 0) {
+ tablePtr->colPixels[tablePtr->cols-1] += diff;
+ tablePtr->colStarts[tablePtr->cols] += diff;
+ }
+ }
+
+ TableAdjustActive(tablePtr);
+
+ /*
+ * now check the new value of topleft cell against the originals,
+ * If they changed, invalidate the area, else leave it alone
+ */
+ if (tablePtr->topRow != tablePtr->oldTopRow ||
+ tablePtr->leftCol != tablePtr->oldLeftCol) {
+ /* set the old top row/col for the next time this function is called */
+ tablePtr->oldTopRow = tablePtr->topRow;
+ tablePtr->oldLeftCol = tablePtr->leftCol;
+ /* only the upper corner title cells wouldn't change */
+ TableInvalidateAll(tablePtr, 0);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableCursorEvent --
+ * Toggle the cursor status. Equivalent to EntryBlinkProc.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The cursor will be switched off/on.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+TableCursorEvent(ClientData clientData)
+{
+ register Table *tablePtr = (Table *) clientData;
+
+ if (!(tablePtr->flags & HAS_FOCUS) || (tablePtr->insertOffTime == 0)
+ || (tablePtr->flags & ACTIVE_DISABLED)
+ || (tablePtr->state != STATE_NORMAL)) {
+ return;
+ }
+
+ if (tablePtr->cursorTimer != NULL) {
+ Tcl_DeleteTimerHandler(tablePtr->cursorTimer);
+ }
+
+ tablePtr->cursorTimer =
+ Tcl_CreateTimerHandler((tablePtr->flags & CURSOR_ON) ?
+ tablePtr->insertOffTime : tablePtr->insertOnTime,
+ TableCursorEvent, (ClientData) tablePtr);
+
+ /* Toggle the cursor */
+ tablePtr->flags ^= CURSOR_ON;
+
+ /* invalidate the cell */
+ TableRefresh(tablePtr, tablePtr->activeRow, tablePtr->activeCol, CELL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableConfigCursor --
+ * Configures the timer depending on the state of the table.
+ * Equivalent to EntryFocusProc.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The cursor will be switched off/on.
+ *
+ *----------------------------------------------------------------------
+ */
+void
+TableConfigCursor(register Table *tablePtr)
+{
+ /*
+ * To have a cursor, we have to have focus and allow edits
+ */
+ if ((tablePtr->flags & HAS_FOCUS) && (tablePtr->state == STATE_NORMAL) &&
+ !(tablePtr->flags & ACTIVE_DISABLED)) {
+ /*
+ * Turn the cursor ON
+ */
+ if (!(tablePtr->flags & CURSOR_ON)) {
+ tablePtr->flags |= CURSOR_ON;
+ /*
+ * Only refresh when we toggled cursor
+ */
+ TableRefresh(tablePtr, tablePtr->activeRow, tablePtr->activeCol,
+ CELL);
+ }
+
+ /* set up the first timer */
+ if (tablePtr->insertOffTime != 0) {
+ /* make sure nothing existed */
+ Tcl_DeleteTimerHandler(tablePtr->cursorTimer);
+ tablePtr->cursorTimer =
+ Tcl_CreateTimerHandler(tablePtr->insertOnTime,
+ TableCursorEvent, (ClientData) tablePtr);
+ }
+ } else {
+ /*
+ * Turn the cursor OFF
+ */
+ if ((tablePtr->flags & CURSOR_ON)) {
+ tablePtr->flags &= ~CURSOR_ON;
+ TableRefresh(tablePtr, tablePtr->activeRow, tablePtr->activeCol,
+ CELL);
+ }
+
+ /* and disable the timer */
+ if (tablePtr->cursorTimer != NULL) {
+ Tcl_DeleteTimerHandler(tablePtr->cursorTimer);
+ }
+ tablePtr->cursorTimer = NULL;
+ }
+
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableFetchSelection --
+ * This procedure is called back by Tk when the selection is
+ * requested by someone. It returns part or all of the selection
+ * in a buffer provided by the caller.
+ *
+ * Results:
+ * The return value is the number of non-NULL bytes stored
+ * at buffer. Buffer is filled (or partially filled) with a
+ * NULL-terminated string containing part or all of the selection,
+ * as given by offset and maxBytes.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+TableFetchSelection(clientData, offset, buffer, maxBytes)
+ ClientData clientData; /* Information about table widget. */
+ int offset; /* Offset within selection of first
+ * character to be returned. */
+ char *buffer; /* Location in which to place selection. */
+ int maxBytes; /* Maximum number of bytes to place at buffer,
+ * not including terminating NULL. */
+{
+ register Table *tablePtr = (Table *) clientData;
+ Tcl_Interp *interp = tablePtr->interp;
+ char *value, *data, *rowsep = tablePtr->rowSep, *colsep = tablePtr->colSep;
+ Tcl_DString selection;
+ Tcl_HashEntry *entryPtr;
+ Tcl_HashSearch search;
+ int length, count, lastrow=0, needcs=0, r, c, listArgc, rslen=0, cslen=0;
+ int numcols, numrows;
+ CONST84 char **listArgv;
+
+ /* if we are not exporting the selection ||
+ * we have no data source, return */
+ if (!tablePtr->exportSelection ||
+ (tablePtr->dataSource == DATA_NONE)) {
+ return -1;
+ }
+
+ /* First get a sorted list of the selected elements */
+ Tcl_DStringInit(&selection);
+ for (entryPtr = Tcl_FirstHashEntry(tablePtr->selCells, &search);
+ entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&search)) {
+ Tcl_DStringAppendElement(&selection,
+ Tcl_GetHashKey(tablePtr->selCells, entryPtr));
+ }
+ value = TableCellSort(tablePtr, Tcl_DStringValue(&selection));
+ Tcl_DStringFree(&selection);
+
+ if (value == NULL ||
+ Tcl_SplitList(interp, value, &listArgc, &listArgv) != TCL_OK) {
+ return -1;
+ }
+ Tcl_Free(value);
+
+ Tcl_DStringInit(&selection);
+ rslen = (rowsep?(strlen(rowsep)):0);
+ cslen = (colsep?(strlen(colsep)):0);
+ numrows = numcols = 0;
+ for (count = 0; count < listArgc; count++) {
+ TableParseArrayIndex(&r, &c, listArgv[count]);
+ if (count) {
+ if (lastrow != r) {
+ lastrow = r;
+ needcs = 0;
+ if (rslen) {
+ Tcl_DStringAppend(&selection, rowsep, rslen);
+ } else {
+ Tcl_DStringEndSublist(&selection);
+ Tcl_DStringStartSublist(&selection);
+ }
+ ++numrows;
+ } else {
+ if (++needcs > numcols)
+ numcols = needcs;
+ }
+ } else {
+ lastrow = r;
+ needcs = 0;
+ if (!rslen) {
+ Tcl_DStringStartSublist(&selection);
+ }
+ }
+ data = TableGetCellValue(tablePtr, r, c);
+ if (cslen) {
+ if (needcs) {
+ Tcl_DStringAppend(&selection, colsep, cslen);
+ }
+ Tcl_DStringAppend(&selection, data, -1);
+ } else {
+ Tcl_DStringAppendElement(&selection, data);
+ }
+ }
+ if (!rslen && count) {
+ Tcl_DStringEndSublist(&selection);
+ }
+ Tcl_Free((char *) listArgv);
+
+ if (tablePtr->selCmd != NULL) {
+ Tcl_DString script;
+ Tcl_DStringInit(&script);
+ ExpandPercents(tablePtr, tablePtr->selCmd, numrows+1, numcols+1,
+ Tcl_DStringValue(&selection), (char *)NULL,
+ listArgc, &script, CMD_ACTIVATE);
+ if (Tcl_GlobalEval(interp, Tcl_DStringValue(&script)) == TCL_ERROR) {
+ Tcl_AddErrorInfo(interp,
+ "\n (error in table selection command)");
+ Tcl_BackgroundError(interp);
+ Tcl_DStringFree(&script);
+ Tcl_DStringFree(&selection);
+ return -1;
+ } else {
+ Tcl_DStringGetResult(interp, &selection);
+ }
+ Tcl_DStringFree(&script);
+ }
+
+ length = Tcl_DStringLength(&selection);
+
+ if (length == 0)
+ return -1;
+
+ /* Copy the requested portion of the selection to the buffer. */
+ count = length - offset;
+ if (count <= 0) {
+ count = 0;
+ } else {
+ if (count > maxBytes) {
+ count = maxBytes;
+ }
+ memcpy((VOID *) buffer,
+ (VOID *) (Tcl_DStringValue(&selection) + offset),
+ (size_t) count);
+ }
+ buffer[count] = '\0';
+ Tcl_DStringFree(&selection);
+ return count;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableLostSelection --
+ * This procedure is called back by Tk when the selection is
+ * grabbed away from a table widget.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The existing selection is unhighlighted, and the window is
+ * marked as not containing a selection.
+ *
+ *----------------------------------------------------------------------
+ */
+void
+TableLostSelection(clientData)
+ ClientData clientData; /* Information about table widget. */
+{
+ register Table *tablePtr = (Table *) clientData;
+
+ if (tablePtr->exportSelection) {
+ Tcl_HashEntry *entryPtr;
+ Tcl_HashSearch search;
+ int row, col;
+
+ /* Same as SEL CLEAR ALL */
+ for (entryPtr = Tcl_FirstHashEntry(tablePtr->selCells, &search);
+ entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&search)) {
+ TableParseArrayIndex(&row, &col,
+ Tcl_GetHashKey(tablePtr->selCells,entryPtr));
+ Tcl_DeleteHashEntry(entryPtr);
+ TableRefresh(tablePtr, row-tablePtr->rowOffset,
+ col-tablePtr->colOffset, CELL);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableRestrictProc --
+ * A Tk_RestrictProc used by TableValidateChange to eliminate any
+ * extra key input events in the event queue that
+ * have a serial number no less than a given value.
+ *
+ * Results:
+ * Returns either TK_DISCARD_EVENT or TK_DEFER_EVENT.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+static Tk_RestrictAction
+TableRestrictProc(serial, eventPtr)
+ ClientData serial;
+ XEvent *eventPtr;
+{
+ if ((eventPtr->type == KeyRelease || eventPtr->type == KeyPress) &&
+ ((eventPtr->xany.serial-(unsigned int)serial) > 0)) {
+ return TK_DEFER_EVENT;
+ } else {
+ return TK_PROCESS_EVENT;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TableValidateChange --
+ * This procedure is invoked when any character is added or
+ * removed from the table widget, or a set has triggered validation.
+ *
+ * Results:
+ * TCL_OK if the validatecommand accepts the new string,
+ * TCL_BREAK if the validatecommand rejects the new string,
+ * TCL_ERROR if any problems occured with validatecommand.
+ *
+ * Side effects:
+ * The insertion/deletion may be aborted, and the
+ * validatecommand might turn itself off (if an error
+ * or loop condition arises).
+ *
+ *--------------------------------------------------------------
+ */
+int
+TableValidateChange(tablePtr, r, c, old, new, index)
+ register Table *tablePtr; /* Table that needs validation. */
+ int r, c; /* row,col index of cell in user coords */
+ char *old; /* current value of cell */
+ char *new; /* potential new value of cell */
+ int index; /* index of insert/delete, -1 otherwise */
+{
+ register Tcl_Interp *interp = tablePtr->interp;
+ int code, bool;
+ Tk_RestrictProc *rstrct;
+ ClientData cdata;
+ Tcl_DString script;
+
+ if (tablePtr->valCmd == NULL || tablePtr->validate == 0) {
+ return TCL_OK;
+ }
+
+ /* Magic code to make this bit of code UI synchronous in the face of
+ * possible new key events */
+ XSync(tablePtr->display, False);
+ rstrct = Tk_RestrictEvents(TableRestrictProc, (ClientData)
+ NextRequest(tablePtr->display), &cdata);
+
+ /*
+ * If we're already validating, then we're hitting a loop condition
+ * Return and set validate to 0 to disallow further validations
+ * and prevent current validation from finishing
+ */
+ if (tablePtr->flags & VALIDATING) {
+ tablePtr->validate = 0;
+ return TCL_OK;
+ }
+ tablePtr->flags |= VALIDATING;
+
+ /* Now form command string and run through the -validatecommand */
+ Tcl_DStringInit(&script);
+ ExpandPercents(tablePtr, tablePtr->valCmd, r, c, old, new, index, &script,
+ CMD_VALIDATE);
+ code = Tcl_GlobalEval(tablePtr->interp, Tcl_DStringValue(&script));
+ Tcl_DStringFree(&script);
+
+ if (code != TCL_OK && code != TCL_RETURN) {
+ Tcl_AddErrorInfo(interp,
+ "\n\t(in validation command executed by table)");
+ Tcl_BackgroundError(interp);
+ code = TCL_ERROR;
+ } else if (Tcl_GetBooleanFromObj(interp, Tcl_GetObjResult(interp),
+ &bool) != TCL_OK) {
+ Tcl_AddErrorInfo(interp,
+ "\n\tboolean not returned by validation command");
+ Tcl_BackgroundError(interp);
+ code = TCL_ERROR;
+ } else {
+ code = (bool) ? TCL_OK : TCL_BREAK;
+ }
+ Tcl_SetObjResult(interp, Tcl_NewObj());
+
+ /*
+ * If ->validate has become VALIDATE_NONE during the validation,
+ * it means that a loop condition almost occured. Do not allow
+ * this validation result to finish.
+ */
+ if (tablePtr->validate == 0) {
+ code = TCL_ERROR;
+ }
+
+ /* If validate will return ERROR, then disallow further validations */
+ if (code == TCL_ERROR) {
+ tablePtr->validate = 0;
+ }
+
+ Tk_RestrictEvents(rstrct, cdata, &cdata);
+ tablePtr->flags &= ~VALIDATING;
+
+ return code;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ExpandPercents --
+ * Given a command and an event, produce a new command
+ * by replacing % constructs in the original command
+ * with information from the X event.
+ *
+ * Results:
+ * The new expanded command is appended to the dynamic string
+ * given by dsPtr.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+void
+ExpandPercents(tablePtr, before, r, c, old, new, index, dsPtr, cmdType)
+ Table *tablePtr; /* Table that needs validation. */
+ char *before; /* Command containing percent
+ * expressions to be replaced. */
+ int r, c; /* row,col index of cell */
+ char *old; /* current value of cell */
+ char *new; /* potential new value of cell */
+ int index; /* index of insert/delete */
+ Tcl_DString *dsPtr; /* Dynamic string in which to append
+ * new command. */
+ int cmdType; /* type of command to make %-subs for */
+{
+ int length, spaceNeeded, cvtFlags;
+#ifdef TCL_UTF_MAX
+ Tcl_UniChar ch;
+#else
+ char ch;
+#endif
+ char *string, buf[INDEX_BUFSIZE];
+
+ /* This returns the static value of the string as set in the array */
+ if (old == NULL && cmdType == CMD_VALIDATE) {
+ old = TableGetCellValue(tablePtr, r, c);
+ }
+
+ while (1) {
+ if (*before == '\0') {
+ break;
+ }
+ /*
+ * Find everything up to the next % character and append it
+ * to the result string.
+ */
+
+ string = before;
+#ifdef TCL_UTF_MAX
+ /* No need to convert '%', as it is in ascii range */
+ string = (char *) Tcl_UtfFindFirst(before, '%');
+#else
+ string = strchr(before, '%');
+#endif
+ if (string == (char *) NULL) {
+ Tcl_DStringAppend(dsPtr, before, -1);
+ break;
+ } else if (string != before) {
+ Tcl_DStringAppend(dsPtr, before, string-before);
+ before = string;
+ }
+
+ /*
+ * There's a percent sequence here. Process it.
+ */
+
+ before++; /* skip over % */
+ if (*before != '\0') {
+#ifdef TCL_UTF_MAX
+ before += Tcl_UtfToUniChar(before, &ch);
+#else
+ ch = before[0];
+ before++;
+#endif
+ } else {
+ ch = '%';
+ }
+ switch (ch) {
+ case 'c':
+ sprintf(buf, "%d", c);
+ string = buf;
+ break;
+ case 'C': /* index of cell */
+ TableMakeArrayIndex(r, c, buf);
+ string = buf;
+ break;
+ case 'r':
+ sprintf(buf, "%d", r);
+ string = buf;
+ break;
+ case 'i': /* index of cursor OR |number| of cells selected */
+ sprintf(buf, "%d", index);
+ string = buf;
+ break;
+ case 's': /* Current cell value */
+ string = old;
+ break;
+ case 'S': /* Potential new value of cell */
+ string = (new?new:old);
+ break;
+ case 'W': /* widget name */
+ string = Tk_PathName(tablePtr->tkwin);
+ break;
+ default:
+#ifdef TCL_UTF_MAX
+ length = Tcl_UniCharToUtf(ch, buf);
+#else
+ buf[0] = ch;
+ length = 1;
+#endif
+ buf[length] = '\0';
+ string = buf;
+ break;
+ }
+
+ spaceNeeded = Tcl_ScanElement(string, &cvtFlags);
+ length = Tcl_DStringLength(dsPtr);
+ Tcl_DStringSetLength(dsPtr, length + spaceNeeded);
+ spaceNeeded = Tcl_ConvertElement(string,
+ Tcl_DStringValue(dsPtr) + length,
+ cvtFlags | TCL_DONT_USE_BRACES);
+ Tcl_DStringSetLength(dsPtr, length + spaceNeeded);
+ }
+ Tcl_DStringAppend(dsPtr, "", 1);
+}
+
+/* Function to call on loading the Table module */
+
+#ifdef BUILD_Tktable
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLEXPORT
+#endif
+#ifdef MAC_TCL
+#pragma export on
+#endif
+EXTERN int
+Tktable_Init(interp)
+ Tcl_Interp *interp;
+{
+ /* This defines the static chars tkTable(Safe)InitScript */
+#include "tkTableInitScript.h"
+
+ if (
+#ifdef USE_TCL_STUBS
+ Tcl_InitStubs(interp, "8.0", 0)
+#else
+ Tcl_PkgRequire(interp, "Tcl", "8.0", 0)
+#endif
+ == NULL) {
+ return TCL_ERROR;
+ }
+ if (
+#ifdef USE_TK_STUBS
+ Tk_InitStubs(interp, "8.0", 0)
+#else
+# if (TK_MAJOR_VERSION == 8) && (TK_MINOR_VERSION == 0)
+ /* We require 8.0 exact because of the Unicode in 8.1+ */
+ Tcl_PkgRequire(interp, "Tk", "8.0", 1)
+# else
+ Tcl_PkgRequire(interp, "Tk", "8.0", 0)
+# endif
+#endif
+ == NULL) {
+ return TCL_ERROR;
+ }
+ if (Tcl_PkgProvide(interp, "Tktable", PACKAGE_VERSION) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tcl_CreateObjCommand(interp, TBL_COMMAND, Tk_TableObjCmd,
+ (ClientData) Tk_MainWindow(interp),
+ (Tcl_CmdDeleteProc *) NULL);
+
+ /*
+ * The init script can't make certain calls in a safe interpreter,
+ * so we always have to use the embedded runtime for it
+ */
+ return Tcl_Eval(interp, Tcl_IsSafe(interp) ?
+ tkTableSafeInitScript : tkTableInitScript);
+}
+
+EXTERN int
+Tktable_SafeInit(interp)
+ Tcl_Interp *interp;
+{
+ return Tktable_Init(interp);
+}
+#ifdef MAC_TCL
+#pragma export reset
+#endif
+
+#ifdef WIN32
+/*
+ *----------------------------------------------------------------------
+ *
+ * DllEntryPoint --
+ *
+ * This wrapper function is used by Windows to invoke the
+ * initialization code for the DLL. If we are compiling
+ * with Visual C++, this routine will be renamed to DllMain.
+ * routine.
+ *
+ * Results:
+ * Returns TRUE;
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+BOOL APIENTRY
+DllEntryPoint(hInst, reason, reserved)
+ HINSTANCE hInst; /* Library instance handle. */
+ DWORD reason; /* Reason this function is being called. */
+ LPVOID reserved; /* Not used. */
+{
+ return TRUE;
+}
+#endif
diff --git a/tktable/generic/tkTable.h b/tktable/generic/tkTable.h
new file mode 100644
index 0000000..cfb83e7
--- /dev/null
+++ b/tktable/generic/tkTable.h
@@ -0,0 +1,658 @@
+/*
+ * tkTable.h --
+ *
+ * This is the header file for the module that implements
+ * table widgets for the Tk toolkit.
+ *
+ * Copyright (c) 1997-2002 Jeffrey Hobbs
+ *
+ * See the file "license.txt" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id: tkTable.h,v 1.17 2004/07/20 20:46:21 hobbs Exp $
+ */
+
+#ifndef _TKTABLE_H_
+#define _TKTABLE_H_
+
+#include
+#include
+#include
+#include
+#ifdef MAC_TCL
+# include
+#else
+# include
+#endif /* MAC_TCL */
+
+#if (TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION == 0) /* Tcl8.0 stuff */
+#define Tcl_GetString(objPtr) Tcl_GetStringFromObj(objPtr, (int *)NULL)
+#endif
+
+#if (TCL_MAJOR_VERSION > 8) || ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION >= 4))
+# define HAVE_TCL84
+#endif
+
+/*
+ * Tcl/Tk 8.4 introduced better CONST-ness in the APIs, but we use CONST84 in
+ * some cases for compatibility with earlier Tcl headers to prevent warnings.
+ */
+#ifndef CONST84
+# define CONST84
+#endif
+
+/* This EXTERN declaration is needed for Tcl < 8.0.3 */
+#ifndef EXTERN
+# ifdef __cplusplus
+# define EXTERN extern "C"
+# else
+# define EXTERN extern
+# endif
+#endif
+
+#ifdef TCL_STORAGE_CLASS
+# undef TCL_STORAGE_CLASS
+#endif
+#ifdef BUILD_Tktable
+# define TCL_STORAGE_CLASS DLLEXPORT
+#else
+# define TCL_STORAGE_CLASS DLLIMPORT
+#endif
+
+#ifdef WIN32
+# define WIN32_LEAN_AND_MEAN
+# include
+# undef WIN32_LEAN_AND_MEAN
+/* VC++ has an entry point called DllMain instead of DllEntryPoint */
+# if defined(_MSC_VER)
+# define DllEntryPoint DllMain
+# endif
+#endif
+
+#if defined(WIN32) || defined(MAC_TCL) || defined(MAC_OSX_TK)
+/* XSync call defined in the internals for some reason */
+# ifndef XSync
+# define XSync(display, bool) {display->request++;}
+# endif
+#endif /* defn of XSync */
+
+#ifndef NORMAL_BG
+# ifdef WIN32
+# define NORMAL_BG "SystemButtonFace"
+# define ACTIVE_BG NORMAL_BG
+# define SELECT_BG "SystemHighlight"
+# define SELECT_FG "SystemHighlightText"
+# define DISABLED "SystemDisabledText"
+# define HIGHLIGHT "SystemWindowFrame"
+# define DEF_TABLE_FONT "{MS Sans Serif} 8"
+# elif defined(MAC_TCL) || defined(MAC_OSX_TK)
+# define NORMAL_BG "systemWindowBody"
+# define ACTIVE_BG "#ececec"
+# define SELECT_BG "systemHighlight"
+# define SELECT_FG "systemHighlightText"
+# define DISABLED "#a3a3a3"
+# define HIGHLIGHT "Black"
+# define DEF_TABLE_FONT "Helvetica 12"
+# else
+# define NORMAL_BG "#d9d9d9"
+# define ACTIVE_BG "#fcfcfc"
+# define SELECT_BG "#c3c3c3"
+# define SELECT_FG "Black"
+# define DISABLED "#a3a3a3"
+# define HIGHLIGHT "Black"
+# define DEF_TABLE_FONT "Helvetica -12"
+# endif
+#endif /* NORMAL_BG */
+
+#define MAX(A,B) (((A)>(B))?(A):(B))
+#define MIN(A,B) (((A)>(B))?(B):(A))
+#define BETWEEN(val,min,max) ( ((val)<(min)) ? (min) : \
+ ( ((val)>(max)) ? (max) : (val) ) )
+#define CONSTRAIN(val,min,max) if ((val) < (min)) { (val) = (min); } \
+ else if ((val) > (max)) { (val) = (max); }
+#define STREQ(s1, s2) (strcmp((s1), (s2)) == 0)
+#define ARSIZE(A) (sizeof(A)/sizeof(*A))
+#define INDEX_BUFSIZE 32 /* max size of buffer for indices */
+#define TEST_KEY "#TEST KEY#" /* index for testing array existence */
+
+/*
+ * Assigned bits of "flags" fields of Table structures, and what those
+ * bits mean:
+ *
+ * REDRAW_PENDING: Non-zero means a DoWhenIdle handler has
+ * already been queued to redisplay the table.
+ * REDRAW_BORDER: Non-zero means 3-D border must be redrawn
+ * around window during redisplay. Normally
+ * only text portion needs to be redrawn.
+ * CURSOR_ON: Non-zero means insert cursor is displayed at
+ * present. 0 means it isn't displayed.
+ * TEXT_CHANGED: Non-zero means the active cell text is being edited.
+ * HAS_FOCUS: Non-zero means this window has the input focus.
+ * HAS_ACTIVE: Non-zero means the active cell is set.
+ * HAS_ANCHOR: Non-zero means the anchor cell is set.
+ * BROWSE_CMD: Non-zero means we're evaluating the -browsecommand.
+ * VALIDATING: Non-zero means we are in a valCmd
+ * SET_ACTIVE: About to set the active array element internally
+ * ACTIVE_DISABLED: Non-zero means the active cell is -state disabled
+ * OVER_BORDER: Non-zero means we are over a table cell border
+ * REDRAW_ON_MAP: Forces a redraw on the unmap
+ * AVOID_SPANS: prevent cell spans from being used
+ *
+ * FIX - consider adding UPDATE_SCROLLBAR a la entry
+ */
+#define REDRAW_PENDING (1L<<0)
+#define CURSOR_ON (1L<<1)
+#define HAS_FOCUS (1L<<2)
+#define TEXT_CHANGED (1L<<3)
+#define HAS_ACTIVE (1L<<4)
+#define HAS_ANCHOR (1L<<5)
+#define BROWSE_CMD (1L<<6)
+#define REDRAW_BORDER (1L<<7)
+#define VALIDATING (1L<<8)
+#define SET_ACTIVE (1L<<9)
+#define ACTIVE_DISABLED (1L<<10)
+#define OVER_BORDER (1L<<11)
+#define REDRAW_ON_MAP (1L<<12)
+#define AVOID_SPANS (1L<<13)
+
+/* Flags for TableInvalidate && TableRedraw */
+#define ROW (1L<<0)
+#define COL (1L<<1)
+#define CELL (1L<<2)
+
+#define CELL_BAD (1<<0)
+#define CELL_OK (1<<1)
+#define CELL_SPAN (1<<2)
+#define CELL_HIDDEN (1<<3)
+#define CELL_VIEWABLE (CELL_OK|CELL_SPAN)
+
+#define INV_FILL (1L<<3) /* use for Redraw when the affected
+ * row/col will affect neighbors */
+#define INV_FORCE (1L<<4)
+#define INV_HIGHLIGHT (1L<<5)
+#define INV_NO_ERR_MSG (1L<<5) /* Don't leave an error message */
+
+/* These alter how the selection set/clear commands behave */
+#define SEL_ROW (1<<0)
+#define SEL_COL (1<<1)
+#define SEL_BOTH (1<<2)
+#define SEL_CELL (1<<3)
+#define SEL_NONE (1<<4)
+
+/*
+ * Definitions for tablePtr->dataSource, by bit
+ */
+#define DATA_NONE 0
+#define DATA_CACHE (1<<1)
+#define DATA_ARRAY (1<<2)
+#define DATA_COMMAND (1<<3)
+
+/*
+ * Definitions for configuring -borderwidth
+ */
+#define BD_TABLE 0
+#define BD_TABLE_TAG (1<<1)
+#define BD_TABLE_WIN (1<<2)
+
+/*
+ * Possible state values for tags
+ */
+typedef enum {
+ STATE_UNUSED, STATE_UNKNOWN, STATE_HIDDEN,
+ STATE_NORMAL, STATE_DISABLED, STATE_ACTIVE, STATE_LAST
+} TableState;
+
+/*
+ * Structure for use in parsing table commands/values.
+ * Accessor functions defined in tkTableUtil.c
+ */
+typedef struct {
+ char *name; /* name of the command/value */
+ int value; /* >0 because 0 represents an error or proc */
+} Cmd_Struct;
+
+/*
+ * The tag structure
+ */
+typedef struct {
+ Tk_3DBorder bg; /* background color */
+ Tk_3DBorder fg; /* foreground color */
+
+ char * borderStr; /* border style */
+ int borders; /* number of borders specified (1, 2 or 4) */
+ int bd[4]; /* cell border width */
+
+ int relief; /* relief type */
+ Tk_Font tkfont; /* Information about text font, or NULL. */
+ Tk_Anchor anchor; /* default anchor point */
+ char * imageStr; /* name of image */
+ Tk_Image image; /* actual pointer to image, if any */
+ TableState state; /* state of the cell */
+ Tk_Justify justify; /* justification of text in the cell */
+ int multiline; /* wrapping style of multiline text */
+ int wrap; /* wrapping style of multiline text */
+ int showtext; /* whether to display text over image */
+ char * ellipsis; /* ellipsis to display on clipped text */
+} TableTag;
+
+/* The widget structure for the table Widget */
+
+typedef struct {
+ /* basic information about the window and the interpreter */
+ Tk_Window tkwin;
+ Display *display;
+ Tcl_Interp *interp;
+ Tcl_Command widgetCmd; /* Token for entry's widget command. */
+
+ /*
+ * Configurable Options
+ */
+ int autoClear;
+ char *selectMode; /* single, browse, multiple, or extended */
+ int selectType; /* row, col, both, or cell */
+ int selectTitles; /* whether to do automatic title selection */
+ int rows, cols; /* number of rows and columns */
+ int defRowHeight; /* default row height in chars (positive)
+ * or pixels (negative) */
+ int defColWidth; /* default column width in chars (positive)
+ * or pixels (negative) */
+ int maxReqCols; /* the requested # cols to display */
+ int maxReqRows; /* the requested # rows to display */
+ int maxReqWidth; /* the maximum requested width in pixels */
+ int maxReqHeight; /* the maximum requested height in pixels */
+ char *arrayVar; /* name of traced array variable */
+ char *rowSep; /* separator string to place between
+ * rows when getting selection */
+ char *colSep; /* separator string to place between
+ * cols when getting selection */
+ TableTag defaultTag; /* the default tag colors/fonts etc */
+ char *yScrollCmd; /* the y-scroll command */
+ char *xScrollCmd; /* the x-scroll command */
+ char *browseCmd; /* the command that is called when the
+ * active cell changes */
+ int caching; /* whether to cache values of table */
+ char *command; /* A command to eval when get/set occurs
+ * for table values */
+ int useCmd; /* Signals whether to use command or the
+ * array variable, will be 0 if command errs */
+ char *selCmd; /* the command that is called to when a
+ * [selection get] call occurs for a table */
+ char *valCmd; /* Command prefix to use when invoking
+ * validate command. NULL means don't
+ * invoke commands. Malloc'ed. */
+ int validate; /* Non-zero means try to validate */
+ Tk_3DBorder insertBg; /* the cursor color */
+ Tk_Cursor cursor; /* the regular mouse pointer */
+ Tk_Cursor bdcursor; /* the mouse pointer when over borders */
+#ifdef TITLE_CURSOR
+ Tk_Cursor titleCursor; /* the mouse pointer when over titles */
+#endif
+ int exportSelection; /* Non-zero means tie internal table
+ * to X selection. */
+ TableState state; /* Normal or disabled. Table is read-only
+ * when disabled. */
+ int insertWidth; /* Total width of insert cursor. */
+ int insertBorderWidth; /* Width of 3-D border around insert cursor. */
+ int insertOnTime; /* Number of milliseconds cursor should spend
+ * in "on" state for each blink. */
+ int insertOffTime; /* Number of milliseconds cursor should spend
+ * in "off" state for each blink. */
+ int invertSelected; /* Whether to draw selected cells swapping
+ * foreground and background */
+ int colStretch; /* The way to stretch columns if the window
+ * is too large */
+ int rowStretch; /* The way to stretch rows if the window is
+ * too large */
+ int colOffset; /* X index of leftmost col in the display */
+ int rowOffset; /* Y index of topmost row in the display */
+ int drawMode; /* The mode to use when redrawing */
+ int flashMode; /* Specifies whether flashing is enabled */
+ int flashTime; /* The number of ms to flash a cell for */
+ int resize; /* -resizeborders option for interactive
+ * resizing of borders */
+ int sparse; /* Whether to use "sparse" arrays by
+ * deleting empty array elements (default) */
+ char *rowTagCmd, *colTagCmd;/* script to eval for getting row/tag cmd */
+ int highlightWidth; /* Width in pixels of highlight to draw
+ * around widget when it has the focus.
+ * <= 0 means don't draw a highlight. */
+ XColor *highlightBgColorPtr;/* Color for drawing traversal highlight
+ * area when highlight is off. */
+ XColor *highlightColorPtr; /* Color for drawing traversal highlight. */
+ char *takeFocus; /* Used only in Tcl to check if this
+ * widget will accept focus */
+ int padX, padY; /* Extra space around text (pixels to leave
+ * on each side). Ignored for bitmaps and
+ * images. */
+ int ipadX, ipadY; /* Space to leave empty around cell borders.
+ * This differs from pad* in that it is always
+ * present for the cell (except windows). */
+
+ /*
+ * Cached Information
+ */
+#ifdef TITLE_CURSOR
+ Tk_Cursor *lastCursorPtr; /* pointer to last cursor defined. */
+#endif
+ int titleRows, titleCols; /* the number of rows|cols to use as a title */
+ /* these are kept in real coords */
+ int topRow, leftCol; /* The topleft cell to display excluding the
+ * fixed title rows. This is just the
+ * config request. The actual cell used may
+ * be different to keep the screen full */
+ int anchorRow, anchorCol; /* the row,col of the anchor cell */
+ int activeRow, activeCol; /* the row,col of the active cell */
+ int oldTopRow, oldLeftCol; /* cached by TableAdjustParams */
+ int oldActRow, oldActCol; /* cached by TableAdjustParams */
+ int icursor; /* The index of the insertion cursor in the
+ * active cell */
+ int flags; /* An or'ed combination of flags concerning
+ * redraw/cursor etc. */
+ int dataSource; /* where our data comes from:
+ * DATA_{NONE,CACHE,ARRAY,COMMAND} */
+ int maxWidth, maxHeight; /* max width|height required in pixels */
+ int charWidth, charHeight; /* size of a character in the default font */
+ int *colPixels, *rowPixels; /* Array of the pixel widths/heights */
+ int *colStarts, *rowStarts; /* Array of start pixels for rows|columns */
+ int scanMarkX, scanMarkY; /* Used by "scan" and "border" to mark */
+ int scanMarkRow, scanMarkCol;/* necessary information for dragto */
+ /* values in these are kept in user coords */
+ Tcl_HashTable *cache; /* value cache */
+
+ /*
+ * colWidths and rowHeights are indexed from 0, so always adjust numbers
+ * by the appropriate *Offset factor
+ */
+ Tcl_HashTable *colWidths; /* hash table of non default column widths */
+ Tcl_HashTable *rowHeights; /* hash table of non default row heights */
+ Tcl_HashTable *spanTbl; /* table for spans */
+ Tcl_HashTable *spanAffTbl; /* table for cells affected by spans */
+ Tcl_HashTable *tagTable; /* table for style tags */
+ Tcl_HashTable *winTable; /* table for embedded windows */
+ Tcl_HashTable *rowStyles; /* table for row styles */
+ Tcl_HashTable *colStyles; /* table for col styles */
+ Tcl_HashTable *cellStyles; /* table for cell styles */
+ Tcl_HashTable *flashCells; /* table of flashing cells */
+ Tcl_HashTable *selCells; /* table of selected cells */
+ Tcl_TimerToken cursorTimer; /* timer token for the cursor blinking */
+ Tcl_TimerToken flashTimer; /* timer token for the cell flashing */
+ char *activeBuf; /* buffer where the selection is kept
+ * for editing the active cell */
+ char **tagPrioNames; /* list of tag names in priority order */
+ TableTag **tagPrios; /* list of tag pointers in priority order */
+ TableTag *activeTagPtr; /* cache of active composite tag */
+ int activeX, activeY; /* cache offset of active layout in cell */
+ int tagPrioSize; /* size of tagPrios list */
+ int tagPrioMax; /* max allocated size of tagPrios list */
+
+ /* The invalid rectangle if there is an update pending */
+ int invalidX, invalidY, invalidWidth, invalidHeight;
+ int seen[4]; /* see TableUndisplay */
+
+#ifdef POSTSCRIPT
+ /* Pointer to information used for generating Postscript for the canvas.
+ * NULL means no Postscript is currently being generated. */
+ struct TkPostscriptInfo *psInfoPtr;
+#endif
+
+#ifdef PROCS
+ Tcl_HashTable *inProc; /* cells where proc is being evaled */
+ int showProcs; /* whether to show embedded proc (1) or
+ * its calculated value (0) */
+ int hasProcs; /* whether table has embedded procs or not */
+#endif
+} Table;
+
+/*
+ * HEADERS FOR EMBEDDED WINDOWS
+ */
+
+/*
+ * A structure of the following type holds information for each window
+ * embedded in a table widget.
+ */
+
+typedef struct TableEmbWindow {
+ Table *tablePtr; /* Information about the overall table
+ * widget. */
+ Tk_Window tkwin; /* Window for this segment. NULL means that
+ * the window hasn't been created yet. */
+ Tcl_HashEntry *hPtr; /* entry into winTable */
+ char *create; /* Script to create window on-demand.
+ * NULL means no such script.
+ * Malloc-ed. */
+ Tk_3DBorder bg; /* background color */
+
+ char *borderStr; /* border style */
+ int borders; /* number of borders specified (1, 2 or 4) */
+ int bd[4]; /* border width for cell around window */
+
+ int relief; /* relief type */
+ int sticky; /* How to align window in space */
+ int padX, padY; /* Padding to leave around each side
+ * of window, in pixels. */
+ int displayed; /* Non-zero means that the window has been
+ * displayed on the screen recently. */
+} TableEmbWindow;
+
+extern Tk_ConfigSpec tableSpecs[];
+
+extern void EmbWinDisplay(Table *tablePtr, Drawable window,
+ TableEmbWindow *ewPtr, TableTag *tagPtr,
+ int x, int y, int width, int height);
+extern void EmbWinUnmap(register Table *tablePtr,
+ int rlo, int rhi, int clo, int chi);
+extern void EmbWinDelete(register Table *tablePtr, TableEmbWindow *ewPtr);
+extern int Table_WinMove(register Table *tablePtr,
+ char *CONST srcPtr, char *CONST destPtr, int flags);
+extern int Table_WinDelete(register Table *tablePtr, char *CONST idxPtr);
+extern int Table_WindowCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);
+extern int TableValidateChange(Table *tablePtr, int r,
+ int c, char *oldVal, char *newVal, int idx);
+extern void TableLostSelection(ClientData clientData);
+extern void TableSetActiveIndex(register Table *tablePtr);
+
+/*
+ * HEADERS IN tkTableCmds.c
+ */
+
+extern int Table_ActivateCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);
+extern int Table_AdjustCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);
+extern int Table_BboxCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);
+extern int Table_BorderCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);
+extern int Table_ClearCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);
+extern int Table_CurselectionCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);
+extern int Table_CurvalueCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);
+extern int Table_GetCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);
+extern int Table_ScanCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);
+extern int Table_SeeCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);
+extern int Table_SelAnchorCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);
+extern int Table_SelClearCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);
+extern int Table_SelIncludesCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);
+extern int Table_SelSetCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);
+extern int Table_ViewCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);
+
+/*
+ * HEADERS IN tkTableEdit.c
+ */
+
+extern int Table_EditCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);
+extern void TableDeleteChars(register Table *tablePtr,
+ int idx, int count);
+extern void TableInsertChars(register Table *tablePtr,
+ int idx, char *string);
+
+/*
+ * HEADERS IN tkTableTag.c
+ */
+
+extern TableTag *TableNewTag(Table *tablePtr);
+extern void TableResetTag(Table *tablePtr, TableTag *tagPtr);
+extern void TableMergeTag(Table *tablePtr, TableTag *baseTag,
+ TableTag *addTag);
+extern void TableInvertTag(TableTag *baseTag);
+extern int TableGetTagBorders(TableTag *tagPtr,
+ int *left, int *right, int *top, int *bottom);
+extern void TableInitTags(Table *tablePtr);
+extern TableTag *FindRowColTag(Table *tablePtr,
+ int cell, int type);
+extern void TableCleanupTag(Table *tablePtr,
+ TableTag *tagPtr);
+extern int Table_TagCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);
+
+/*
+ * HEADERS IN tkTableUtil.c
+ */
+
+extern void Table_ClearHashTable(Tcl_HashTable *hashTblPtr);
+extern int TableOptionBdSet(ClientData clientData,
+ Tcl_Interp *interp, Tk_Window tkwin,
+ CONST84 char *value, char *widgRec, int offset);
+extern char * TableOptionBdGet(ClientData clientData,
+ Tk_Window tkwin, char *widgRec, int offset,
+ Tcl_FreeProc **freeProcPtr);
+extern int TableTagConfigureBd(Table *tablePtr,
+ TableTag *tagPtr, char *oldValue, int nullOK);
+extern int Cmd_OptionSet(ClientData clientData,
+ Tcl_Interp *interp,
+ Tk_Window unused, CONST84 char *value,
+ char *widgRec, int offset);
+extern char * Cmd_OptionGet(ClientData clientData,
+ Tk_Window unused, char *widgRec,
+ int offset, Tcl_FreeProc **freeProcPtr);
+
+/*
+ * HEADERS IN tkTableCell.c
+ */
+
+extern int TableTrueCell(Table *tablePtr, int row, int col,
+ int *trow, int *tcol);
+extern int TableCellCoords(Table *tablePtr, int row,
+ int col, int *rx, int *ry, int *rw, int *rh);
+extern int TableCellVCoords(Table *tablePtr, int row,
+ int col, int *rx, int *ry,
+ int *rw, int *rh, int full);
+extern void TableWhatCell(register Table *tablePtr,
+ int x, int y, int *row, int *col);
+extern int TableAtBorder(Table *tablePtr, int x, int y,
+ int *row, int *col);
+extern char * TableGetCellValue(Table *tablePtr, int r, int c);
+extern int TableSetCellValue(Table *tablePtr, int r, int c,
+ char *value);
+extern int TableMoveCellValue(Table *tablePtr,
+ int fromr, int fromc, char *frombuf,
+ int tor, int toc, char *tobuf, int outOfBounds);
+
+extern int TableGetIcursor(Table *tablePtr, char *arg,
+ int *posn);
+#define TableGetIcursorObj(tablePtr, objPtr, posnPtr) \
+ TableGetIcursor(tablePtr, Tcl_GetString(objPtr), posnPtr)
+extern int TableGetIndex(register Table *tablePtr,
+ char *str, int *row_p, int *col_p);
+#define TableGetIndexObj(tablePtr, objPtr, rowPtr, colPtr) \
+ TableGetIndex(tablePtr, Tcl_GetString(objPtr), rowPtr, colPtr)
+extern int Table_SetCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);
+extern int Table_HiddenCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);
+extern int Table_SpanCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);
+extern void TableSpanSanCheck(register Table *tablePtr);
+
+/*
+ * HEADERS IN TKTABLECELLSORT
+ */
+/*
+ * We keep the old CellSort true because it is used for grabbing
+ * the selection, so we really want them ordered
+ */
+extern char * TableCellSort(Table *tablePtr, char *str);
+#ifdef NO_SORT_CELLS
+# define TableCellSortObj(interp, objPtr) (objPtr)
+#else
+extern Tcl_Obj* TableCellSortObj(Tcl_Interp *interp, Tcl_Obj *listObjPtr);
+#endif
+
+/*
+ * HEADERS IN TKTABLEPS
+ */
+
+#ifdef POSTSCRIPT
+extern int Table_PostscriptCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);
+extern void Tcl_DStringAppendAllTCL_VARARGS(Tcl_DString *, arg1);
+#endif
+
+/*
+ * HEADERS IN TKTABLE
+ */
+
+EXTERN int Tktable_Init(Tcl_Interp *interp);
+EXTERN int Tktable_SafeInit(Tcl_Interp *interp);
+
+extern void TableGetActiveBuf(register Table *tablePtr);
+extern void ExpandPercents(Table *tablePtr, char *before,
+ int r, int c, char *oldVal, char *newVal, int idx,
+ Tcl_DString *dsPtr, int cmdType);
+extern void TableInvalidate(Table *tablePtr, int x, int y,
+ int width, int height, int force);
+extern void TableRefresh(register Table *tablePtr,
+ int arg1, int arg2, int mode);
+extern void TableGeometryRequest(Table *tablePtr);
+extern void TableAdjustActive(register Table *tablePtr);
+extern void TableAdjustParams(register Table *tablePtr);
+extern void TableConfigCursor(register Table *tablePtr);
+extern void TableAddFlash(Table *tablePtr, int row, int col);
+
+
+#define TableInvalidateAll(tablePtr, flags) \
+ TableInvalidate((tablePtr), 0, 0, Tk_Width((tablePtr)->tkwin),\
+ Tk_Height((tablePtr)->tkwin), (flags))
+
+ /*
+ * Turn row/col into an index into the table
+ */
+#define TableMakeArrayIndex(r, c, i) sprintf((i), "%d,%d", (r), (c))
+
+ /*
+ * Turn array index back into row/col
+ * return the number of args parsed (should be two)
+ */
+#define TableParseArrayIndex(r, c, i) sscanf((i), "%d,%d", (r), (c))
+
+ /*
+ * Macro for finding the last cell of the table
+ */
+#define TableGetLastCell(tablePtr, rowPtr, colPtr) \
+ TableWhatCell((tablePtr),\
+ Tk_Width((tablePtr)->tkwin)-(tablePtr)->highlightWidth-1,\
+ Tk_Height((tablePtr)->tkwin)-(tablePtr)->highlightWidth-1,\
+ (rowPtr), (colPtr))
+
+/*
+ * end of header
+ * reset TCL_STORAGE_CLASS to DLLIMPORT.
+ */
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLIMPORT
+
+#endif /* _TKTABLE_H_ */
+
diff --git a/tktable/generic/tkTableCell.c b/tktable/generic/tkTableCell.c
new file mode 100644
index 0000000..a98c335
--- /dev/null
+++ b/tktable/generic/tkTableCell.c
@@ -0,0 +1,1420 @@
+/*
+ * tkTableCell.c --
+ *
+ * This module implements cell oriented functions for table
+ * widgets.
+ *
+ * Copyright (c) 1998-2000 Jeffrey Hobbs
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id: tkTableCell.c,v 1.12 2008/11/14 21:10:12 hobbs Exp $
+ */
+
+#include "tkTable.h"
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableTrueCell --
+ * Takes a row,col pair in user coords and returns the true
+ * cell that it relates to, either dimension bounded, or a
+ * span cell if it was hidden.
+ *
+ * Results:
+ * The true row, col in user coords are placed in the pointers.
+ * If the value changed for some reasons, 0 is returned (it was not
+ * the /true/ cell).
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+int
+TableTrueCell(Table *tablePtr, int r, int c, int *row, int *col)
+{
+ *row = r; *col = c;
+ /*
+ * We check spans before constraints, because we don't want to
+ * constrain and then think we ended up in a span
+ */
+ if (tablePtr->spanAffTbl && !(tablePtr->flags & AVOID_SPANS)) {
+ char buf[INDEX_BUFSIZE];
+ Tcl_HashEntry *entryPtr;
+
+ TableMakeArrayIndex(r, c, buf);
+ entryPtr = Tcl_FindHashEntry(tablePtr->spanAffTbl, buf);
+ if ((entryPtr != NULL) &&
+ ((char *)Tcl_GetHashValue(entryPtr) != NULL)) {
+ /*
+ * This cell is covered by another spanning cell.
+ * We need to return the coords for that spanning cell.
+ */
+ TableParseArrayIndex(row, col, (char *)Tcl_GetHashValue(entryPtr));
+ return 0;
+ }
+ }
+ *row = BETWEEN(r, tablePtr->rowOffset,
+ tablePtr->rows-1+tablePtr->rowOffset);
+ *col = BETWEEN(c, tablePtr->colOffset,
+ tablePtr->cols-1+tablePtr->colOffset);
+ return ((*row == r) && (*col == c));
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableCellCoords --
+ * Takes a row,col pair in real coords and finds it position
+ * on the virtual screen.
+ *
+ * Results:
+ * The virtual x, y, width, and height of the cell
+ * are placed in the pointers.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+int
+TableCellCoords(Table *tablePtr, int row, int col,
+ int *x, int *y, int *w, int *h)
+{
+ register int hl = tablePtr->highlightWidth;
+ int result = CELL_OK;
+
+ if (tablePtr->rows <= 0 || tablePtr->cols <= 0) {
+ *w = *h = *x = *y = 0;
+ return CELL_BAD;
+ }
+ /*
+ * Real coords required, always should be passed acceptable values,
+ * but this is a possible seg fault otherwise
+ */
+ CONSTRAIN(row, 0, tablePtr->rows-1);
+ CONSTRAIN(col, 0, tablePtr->cols-1);
+ *w = tablePtr->colPixels[col];
+ *h = tablePtr->rowPixels[row];
+ /*
+ * Adjust for sizes of spanning cells
+ * and ensure that this cell isn't "hidden"
+ */
+ if (tablePtr->spanAffTbl && !(tablePtr->flags & AVOID_SPANS)) {
+ char buf[INDEX_BUFSIZE];
+ Tcl_HashEntry *entryPtr;
+
+ TableMakeArrayIndex(row+tablePtr->rowOffset,
+ col+tablePtr->colOffset, buf);
+ entryPtr = Tcl_FindHashEntry(tablePtr->spanAffTbl, buf);
+ if (entryPtr != NULL) {
+ int rs, cs;
+ char *cell;
+
+ cell = (char *) Tcl_GetHashValue(entryPtr);
+ if (cell != NULL) {
+ /* This cell is covered by another spanning cell */
+ /* We need to return the coords for that cell */
+ TableParseArrayIndex(&rs, &cs, cell);
+ *w = rs;
+ *h = cs;
+ result = CELL_HIDDEN;
+ goto setxy;
+ }
+ /* Get the actual span values out of spanTbl */
+ entryPtr = Tcl_FindHashEntry(tablePtr->spanTbl, buf);
+ cell = (char *) Tcl_GetHashValue(entryPtr);
+ TableParseArrayIndex(&rs, &cs, cell);
+ if (rs > 0) {
+ /*
+ * Make sure we don't overflow our space
+ */
+ if (row < tablePtr->titleRows) {
+ rs = MIN(tablePtr->titleRows-1, row+rs);
+ } else {
+ rs = MIN(tablePtr->rows-1, row+rs);
+ }
+ *h = tablePtr->rowStarts[rs+1]-tablePtr->rowStarts[row];
+ result = CELL_SPAN;
+ } else if (rs <= 0) {
+ /* currently negative spans are not supported */
+ }
+ if (cs > 0) {
+ /*
+ * Make sure we don't overflow our space
+ */
+ if (col < tablePtr->titleCols) {
+ cs = MIN(tablePtr->titleCols-1, col+cs);
+ } else {
+ cs = MIN(tablePtr->cols-1, col+cs);
+ }
+ *w = tablePtr->colStarts[cs+1]-tablePtr->colStarts[col];
+ result = CELL_SPAN;
+ } else if (cs <= 0) {
+ /* currently negative spans are not supported */
+ }
+ }
+ }
+setxy:
+ *x = hl + tablePtr->colStarts[col];
+ if (col >= tablePtr->titleCols) {
+ *x -= tablePtr->colStarts[tablePtr->leftCol]
+ - tablePtr->colStarts[tablePtr->titleCols];
+ }
+ *y = hl + tablePtr->rowStarts[row];
+ if (row >= tablePtr->titleRows) {
+ *y -= tablePtr->rowStarts[tablePtr->topRow]
+ - tablePtr->rowStarts[tablePtr->titleRows];
+ }
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableCellVCoords --
+ * Takes a row,col pair in real coords and finds it position
+ * on the actual screen. The full arg specifies whether
+ * only 100% visible cells should be considered visible.
+ *
+ * Results:
+ * The x, y, width, and height of the cell are placed in the pointers,
+ * depending upon visibility of the cell.
+ * Returns 0 for hidden and 1 for visible cells.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+int
+TableCellVCoords(Table *tablePtr, int row, int col,
+ int *rx, int *ry, int *rw, int *rh, int full)
+{
+ int x, y, w, h, w0, h0, cellType, hl = tablePtr->highlightWidth;
+
+ if (tablePtr->tkwin == NULL) return 0;
+
+ /*
+ * Necessary to use separate vars in case dummies are passed in
+ */
+ cellType = TableCellCoords(tablePtr, row, col, &x, &y, &w, &h);
+ *rx = x; *ry = y; *rw = w; *rh = h;
+ if (cellType == CELL_OK) {
+ if ((row < tablePtr->topRow && row >= tablePtr->titleRows) ||
+ (col < tablePtr->leftCol && col >= tablePtr->titleCols)) {
+ /*
+ * A non-spanning cell hiding in "dead" space
+ * between title areas and visible cells
+ */
+ return 0;
+ }
+ } else if (cellType == CELL_SPAN) {
+ /*
+ * we might need to treat full better is CELL_SPAN but primary
+ * cell is visible
+ */
+ int topX = tablePtr->colStarts[tablePtr->titleCols]+hl;
+ int topY = tablePtr->rowStarts[tablePtr->titleRows]+hl;
+ if ((col < tablePtr->leftCol) && (col >= tablePtr->titleCols)) {
+ if (full || (x+w < topX)) {
+ return 0;
+ } else {
+ w -= topX-x;
+ x = topX;
+ }
+ }
+ if ((row < tablePtr->topRow) && (row >= tablePtr->titleRows)) {
+ if (full || (y+h < topY)) {
+ return 0;
+ } else {
+ h -= topY-y;
+ y = topY;
+ }
+ }
+ /*
+ * re-set these according to changed coords
+ */
+ *rx = x; *ry = y; *rw = w; *rh = h;
+ } else {
+ /*
+ * If it is a hidden cell, then w,h is the row,col in user coords
+ * of the cell that spans over this one
+ */
+ return 0;
+ }
+ /*
+ * At this point, we know it is on the screen,
+ * but not if we can see 100% of it (if we care)
+ */
+ if (full) {
+ w0 = w; h0 = h;
+ } else {
+ /*
+ * if we don't care about seeing the whole thing, then
+ * make sure we at least see a pixel worth
+ */
+ w0 = h0 = 1;
+ }
+ /*
+ * Is the cell visible?
+ */
+ if ((x < hl) || (y < hl) || ((x+w0) > (Tk_Width(tablePtr->tkwin)-hl))
+ || ((y+h0) > (Tk_Height(tablePtr->tkwin)-hl))) {
+ /* definitely off the screen */
+ return 0;
+ } else {
+ /* if it was full, then w,h are already be properly constrained */
+ if (!full) {
+ *rw = MIN(w, Tk_Width(tablePtr->tkwin)-hl-x);
+ *rh = MIN(h, Tk_Height(tablePtr->tkwin)-hl-y);
+ }
+ return 1;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableWhatCell --
+ * Takes a x,y screen coordinate and determines what cell contains.
+ * that point. This will return cells that are beyond the right/bottom
+ * edge of the viewable screen.
+ *
+ * Results:
+ * The row,col of the cell are placed in the pointers.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+void
+TableWhatCell(register Table *tablePtr, int x, int y, int *row, int *col)
+{
+ int i;
+ x = MAX(0, x); y = MAX(0, y);
+ /* Adjust for table's global highlightthickness border */
+ x -= tablePtr->highlightWidth;
+ y -= tablePtr->highlightWidth;
+ /* Adjust the x coord if not in the column titles to change display coords
+ * into internal coords */
+ x += (x < tablePtr->colStarts[tablePtr->titleCols]) ? 0 :
+ tablePtr->colStarts[tablePtr->leftCol] -
+ tablePtr->colStarts[tablePtr->titleCols];
+ y += (y < tablePtr->rowStarts[tablePtr->titleRows]) ? 0 :
+ tablePtr->rowStarts[tablePtr->topRow] -
+ tablePtr->rowStarts[tablePtr->titleRows];
+ x = MIN(x, tablePtr->maxWidth-1);
+ y = MIN(y, tablePtr->maxHeight-1);
+ for (i = 1; x >= tablePtr->colStarts[i]; i++);
+ *col = i - 1;
+ for (i = 1; y >= tablePtr->rowStarts[i]; i++);
+ *row = i - 1;
+ if (tablePtr->spanAffTbl && !(tablePtr->flags & AVOID_SPANS)) {
+ char buf[INDEX_BUFSIZE];
+ Tcl_HashEntry *entryPtr;
+
+ /* We now correct the returned cell if this was "hidden" */
+ TableMakeArrayIndex(*row+tablePtr->rowOffset,
+ *col+tablePtr->colOffset, buf);
+ entryPtr = Tcl_FindHashEntry(tablePtr->spanAffTbl, buf);
+ if ((entryPtr != NULL) &&
+ /* We have to make sure this was not already hidden
+ * that's an error */
+ ((char *)Tcl_GetHashValue(entryPtr) != NULL)) {
+ /* this is a "hidden" cell */
+ TableParseArrayIndex(row, col, (char *)Tcl_GetHashValue(entryPtr));
+ *row -= tablePtr->rowOffset;
+ *col -= tablePtr->colOffset;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableAtBorder --
+ * Takes a x,y screen coordinate and determines if that point is
+ * over a border.
+ *
+ * Results:
+ * The left/top row,col corresponding to that point are placed in
+ * the pointers. The number of borders (+1 for row, +1 for col)
+ * hit is returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+int
+TableAtBorder(Table * tablePtr, int x, int y, int *row, int *col)
+{
+ int i, brow, bcol, borders = 2, bd[6];
+
+ TableGetTagBorders(&(tablePtr->defaultTag),
+ &bd[0], &bd[1], &bd[2], &bd[3]);
+ bd[4] = (bd[0] + bd[1])/2;
+ bd[5] = (bd[2] + bd[3])/2;
+
+ /*
+ * Constrain x && y appropriately, and adjust x if it is not in the
+ * column titles to change display coords into internal coords.
+ */
+ x = MAX(0, x); y = MAX(0, y);
+ x -= tablePtr->highlightWidth; y -= tablePtr->highlightWidth;
+ x += (x < tablePtr->colStarts[tablePtr->titleCols]) ? 0 :
+ tablePtr->colStarts[tablePtr->leftCol] -
+ tablePtr->colStarts[tablePtr->titleCols];
+ x = MIN(x, tablePtr->maxWidth - 1);
+ for (i = 1; (i <= tablePtr->cols) &&
+ (x + (bd[0] + bd[1])) >= tablePtr->colStarts[i]; i++);
+ if (x > tablePtr->colStarts[--i] + bd[4]) {
+ borders--;
+ *col = -1;
+ bcol = (i < tablePtr->leftCol && i >= tablePtr->titleCols) ?
+ tablePtr->titleCols-1 : i-1;
+ } else {
+ bcol = *col = (i < tablePtr->leftCol && i >= tablePtr->titleCols) ?
+ tablePtr->titleCols-1 : i-1;
+ }
+ y += (y < tablePtr->rowStarts[tablePtr->titleRows]) ? 0 :
+ tablePtr->rowStarts[tablePtr->topRow] -
+ tablePtr->rowStarts[tablePtr->titleRows];
+ y = MIN(y, tablePtr->maxHeight - 1);
+ for (i = 1; i <= tablePtr->rows &&
+ (y + (bd[2] + bd[3])) >= tablePtr->rowStarts[i]; i++);
+ if (y > tablePtr->rowStarts[--i]+bd[5]) {
+ borders--;
+ *row = -1;
+ brow = (i < tablePtr->topRow && i >= tablePtr->titleRows) ?
+ tablePtr->titleRows-1 : i-1;
+ } else {
+ brow = *row = (i < tablePtr->topRow && i >= tablePtr->titleRows) ?
+ tablePtr->titleRows-1 : i-1;
+ }
+ /*
+ * We have to account for spanning cells, which may hide cells.
+ * In that case, we have to decrement our border count.
+ */
+ if (tablePtr->spanAffTbl && !(tablePtr->flags & AVOID_SPANS) && borders) {
+ Tcl_HashEntry *entryPtr1, *entryPtr2 ;
+ char buf1[INDEX_BUFSIZE], buf2[INDEX_BUFSIZE];
+ char *val;
+
+ if (*row != -1) {
+ TableMakeArrayIndex(brow+tablePtr->rowOffset,
+ bcol+tablePtr->colOffset+1, buf1);
+ TableMakeArrayIndex(brow+tablePtr->rowOffset+1,
+ bcol+tablePtr->colOffset+1, buf2);
+ entryPtr1 = Tcl_FindHashEntry(tablePtr->spanAffTbl, buf1);
+ entryPtr2 = Tcl_FindHashEntry(tablePtr->spanAffTbl, buf2);
+ if (entryPtr1 != NULL && entryPtr2 != NULL) {
+ if ((val = (char *) Tcl_GetHashValue(entryPtr1)) != NULL) {
+ strcpy(buf1, val);
+ }
+ if ((val = (char *) Tcl_GetHashValue(entryPtr2)) != NULL) {
+ strcpy(buf2, val);
+ }
+ if (strcmp(buf1, buf2) == 0) {
+ borders--;
+ *row = -1;
+ }
+ }
+ }
+ if (*col != -1) {
+ TableMakeArrayIndex(brow+tablePtr->rowOffset+1,
+ bcol+tablePtr->colOffset, buf1);
+ TableMakeArrayIndex(brow+tablePtr->rowOffset+1,
+ bcol+tablePtr->colOffset+1, buf2);
+ entryPtr1 = Tcl_FindHashEntry(tablePtr->spanAffTbl, buf1);
+ entryPtr2 = Tcl_FindHashEntry(tablePtr->spanAffTbl, buf2);
+ if (entryPtr1 != NULL && entryPtr2 != NULL) {
+ if ((val = (char *) Tcl_GetHashValue(entryPtr1)) != NULL) {
+ strcpy(buf1, val);
+ }
+ if ((val = (char *) Tcl_GetHashValue(entryPtr2)) != NULL) {
+ strcpy(buf2, val);
+ }
+ if (strcmp(buf1, buf2) == 0) {
+ borders--;
+ *col = -1;
+ }
+ }
+ }
+ }
+ return borders;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableGetCellValue --
+ * Takes a row,col pair in user coords and returns the value for
+ * that cell. This varies depending on what data source the
+ * user has selected.
+ *
+ * Results:
+ * The value of the cell is returned. The return value is VOLATILE
+ * (do not free).
+ *
+ * Side effects:
+ * The value will be cached if caching is turned on.
+ *
+ *----------------------------------------------------------------------
+ */
+char *
+TableGetCellValue(Table *tablePtr, int r, int c)
+{
+ register Tcl_Interp *interp = tablePtr->interp;
+ char *result = NULL;
+ char buf[INDEX_BUFSIZE];
+ Tcl_HashEntry *entryPtr = NULL;
+ int new;
+
+ TableMakeArrayIndex(r, c, buf);
+
+ if (tablePtr->dataSource == DATA_CACHE) {
+ /*
+ * only cache as data source - just rely on cache
+ */
+ entryPtr = Tcl_FindHashEntry(tablePtr->cache, buf);
+ if (entryPtr) {
+ result = (char *) Tcl_GetHashValue(entryPtr);
+ }
+ goto VALUE;
+ }
+ if (tablePtr->caching) {
+ /*
+ * If we are caching, let's see if we have the value cached.
+ * If so, use it, otherwise it will be cached after retrieving
+ * from the other data source.
+ */
+ entryPtr = Tcl_CreateHashEntry(tablePtr->cache, buf, &new);
+ if (!new) {
+ result = (char *) Tcl_GetHashValue(entryPtr);
+ goto VALUE;
+ }
+ }
+ if (tablePtr->dataSource & DATA_COMMAND) {
+ Tcl_DString script;
+ Tcl_DStringInit(&script);
+ ExpandPercents(tablePtr, tablePtr->command, r, c, "", (char *)NULL,
+ 0, &script, 0);
+ if (Tcl_GlobalEval(interp, Tcl_DStringValue(&script)) == TCL_ERROR) {
+ tablePtr->useCmd = 0;
+ tablePtr->dataSource &= ~DATA_COMMAND;
+ if (tablePtr->arrayVar)
+ tablePtr->dataSource |= DATA_ARRAY;
+ Tcl_AddErrorInfo(interp, "\n\t(in -command evaled by table)");
+ Tcl_AddErrorInfo(interp, Tcl_DStringValue(&script));
+ Tcl_BackgroundError(interp);
+ TableInvalidateAll(tablePtr, 0);
+ } else {
+ result = (char *) Tcl_GetStringResult(interp);
+ }
+ Tcl_DStringFree(&script);
+ }
+ if (tablePtr->dataSource & DATA_ARRAY) {
+ result = (char *) Tcl_GetVar2(interp, tablePtr->arrayVar, buf,
+ TCL_GLOBAL_ONLY);
+ }
+ if (tablePtr->caching && entryPtr != NULL) {
+ /*
+ * If we are caching, make sure we cache the returned value
+ *
+ * entryPtr will have been set from above, but check to make sure
+ * someone didn't change caching during -command evaluation.
+ */
+ char *val = NULL;
+ if (result) {
+ val = (char *)ckalloc(strlen(result)+1);
+ strcpy(val, result);
+ }
+ Tcl_SetHashValue(entryPtr, val);
+ }
+VALUE:
+#ifdef PROCS
+ if (result != NULL) {
+ /* Do we have procs, are we showing their value, is this a proc? */
+ if (tablePtr->hasProcs && !tablePtr->showProcs && *result == '=' &&
+ !(r-tablePtr->rowOffset == tablePtr->activeRow &&
+ c-tablePtr->colOffset == tablePtr->activeCol)) {
+ Tcl_DString script;
+ /* provides a rough mutex on preventing proc loops */
+ entryPtr = Tcl_CreateHashEntry(tablePtr->inProc, buf, &new);
+ if (!new) {
+ Tcl_SetHashValue(entryPtr, 1);
+ Tcl_AddErrorInfo(interp, "\n\t(loop hit in proc evaled by table)");
+ return result;
+ }
+ Tcl_SetHashValue(entryPtr, 0);
+ Tcl_DStringInit(&script);
+ ExpandPercents(tablePtr, result+1, r, c, result+1, (char *)NULL,
+ 0, &script, 0);
+ if (Tcl_GlobalEval(interp, Tcl_DStringValue(&script)) != TCL_OK ||
+ Tcl_GetHashValue(entryPtr) == 1) {
+ Tcl_AddErrorInfo(interp, "\n\tin proc evaled by table:\n");
+ Tcl_AddErrorInfo(interp, Tcl_DStringValue(&script));
+ Tcl_BackgroundError(interp);
+ } else {
+ result = Tcl_GetStringResult(interp);
+ }
+ /*
+ * XXX FIX: Can't free result that we still need.
+ * Use ref-counted objects instead.
+ */
+ Tcl_FreeResult(interp);
+ Tcl_DStringFree(&script);
+ Tcl_DeleteHashEntry(entryPtr);
+ }
+ }
+#endif
+ return (result?result:"");
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableSetCellValue --
+ * Takes a row,col pair in user coords and saves the given value for
+ * that cell. This varies depending on what data source the
+ * user has selected.
+ *
+ * Results:
+ * Returns TCL_ERROR or TCL_OK, depending on whether an error
+ * occured during set (ie: during evaluation of -command).
+ *
+ * Side effects:
+ * If the value is NULL (empty string), it will be unset from
+ * an array rather than set to the empty string.
+ *
+ *----------------------------------------------------------------------
+ */
+int
+TableSetCellValue(Table *tablePtr, int r, int c, char *value)
+{
+ char buf[INDEX_BUFSIZE];
+ int code = TCL_OK, flash = 0;
+ Tcl_Interp *interp = tablePtr->interp;
+
+ TableMakeArrayIndex(r, c, buf);
+
+ if (tablePtr->state == STATE_DISABLED) {
+ return TCL_OK;
+ }
+ if (tablePtr->dataSource & DATA_COMMAND) {
+ Tcl_DString script;
+
+ Tcl_DStringInit(&script);
+ ExpandPercents(tablePtr, tablePtr->command, r, c, value, (char *)NULL,
+ 1, &script, 0);
+ if (Tcl_GlobalEval(interp, Tcl_DStringValue(&script)) == TCL_ERROR) {
+ /* An error resulted. Prevent further triggering of the command
+ * and set up the error message. */
+ tablePtr->useCmd = 0;
+ tablePtr->dataSource &= ~DATA_COMMAND;
+ if (tablePtr->arrayVar)
+ tablePtr->dataSource |= DATA_ARRAY;
+ Tcl_AddErrorInfo(interp, "\n\t(in command executed by table)");
+ Tcl_BackgroundError(interp);
+ code = TCL_ERROR;
+ } else {
+ flash = 1;
+ }
+ Tcl_SetResult(interp, (char *) NULL, TCL_STATIC);
+ Tcl_DStringFree(&script);
+ }
+ if (tablePtr->dataSource & DATA_ARRAY) {
+ /* Warning: checking for \0 as the first char could invalidate
+ * allowing it as a valid first char, but only with incorrect utf-8
+ */
+ if ((value == NULL || *value == '\0') && tablePtr->sparse) {
+ Tcl_UnsetVar2(interp, tablePtr->arrayVar, buf, TCL_GLOBAL_ONLY);
+ value = NULL;
+ } else if (Tcl_SetVar2(interp, tablePtr->arrayVar, buf, value,
+ TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
+ code = TCL_ERROR;
+ }
+ }
+ if (code == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * This would be repetitive if we are using the array (which traces).
+ */
+ if (tablePtr->caching && !(tablePtr->dataSource & DATA_ARRAY)) {
+ Tcl_HashEntry *entryPtr;
+ int new;
+ char *val = NULL;
+
+ entryPtr = Tcl_CreateHashEntry(tablePtr->cache, buf, &new);
+ if (!new) {
+ val = (char *) Tcl_GetHashValue(entryPtr);
+ if (val) ckfree(val);
+ }
+ if (value) {
+ val = (char *)ckalloc(strlen(value)+1);
+ strcpy(val, value);
+ }
+ Tcl_SetHashValue(entryPtr, val);
+ flash = 1;
+ }
+ /* We do this conditionally because the var array already has
+ * it's own check to flash */
+ if (flash && tablePtr->flashMode) {
+ r -= tablePtr->rowOffset;
+ c -= tablePtr->colOffset;
+ TableAddFlash(tablePtr, r, c);
+ TableRefresh(tablePtr, r, c, CELL);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableMoveCellValue --
+ * To move cells faster on delete/insert line or col when cache is on
+ * and variable, command is off.
+ * To avoid another call to TableMakeArrayIndex(r, c, buf),
+ * we optionally provide the buffers.
+ * outOfBounds means we will just set the cell value to ""
+ *
+ * Results:
+ * Returns TCL_ERROR or TCL_OK, depending on whether an error
+ * occured during set (ie: during evaluation of -command).
+ *
+ * Side effects:
+ * If the value is NULL (empty string), it will be unset from
+ * an array rather than set to the empty string.
+ *
+ *----------------------------------------------------------------------
+ */
+int
+TableMoveCellValue(Table *tablePtr, int fromr, int fromc, char *frombuf,
+ int tor, int toc, char *tobuf, int outOfBounds)
+{
+ if (outOfBounds) {
+ return TableSetCellValue(tablePtr, tor, toc, "");
+ }
+
+ if (tablePtr->dataSource == DATA_CACHE) {
+ char *val;
+ char *result = NULL;
+ Tcl_HashEntry *entryPtr;
+
+ /*
+ * Let's see if we have the from value cached. If so, copy
+ * that to the to cell. The to cell entry value will be
+ * deleted from the cache, and recreated only if from value
+ * was not NULL.
+ * We can be liberal removing our internal cached cells when
+ * DATA_CACHE is our only data source.
+ */
+ entryPtr = Tcl_FindHashEntry(tablePtr->cache, frombuf);
+ if (entryPtr) {
+ result = (char *) Tcl_GetHashValue(entryPtr);
+ /*
+ * we set tho old value to NULL
+ */
+ Tcl_DeleteHashEntry(entryPtr);
+ }
+ if (result) {
+ int new;
+ /*
+ * We enter here when there was a from value.
+ * set 'to' to the 'from' value without new mallocing.
+ */
+ entryPtr = Tcl_CreateHashEntry(tablePtr->cache, tobuf, &new);
+ /*
+ * free old value
+ */
+ if (!new) {
+ val = (char *) Tcl_GetHashValue(entryPtr);
+ if (val) ckfree(val);
+ }
+ Tcl_SetHashValue(entryPtr, result);
+ } else {
+ entryPtr = Tcl_FindHashEntry(tablePtr->cache, tobuf);
+ if (entryPtr) {
+ val = (char *) Tcl_GetHashValue(entryPtr);
+ if (val) ckfree(val);
+ Tcl_DeleteHashEntry(entryPtr);
+ }
+ }
+ return TCL_OK;
+ }
+ /*
+ * We have to do it the old way
+ */
+ return TableSetCellValue(tablePtr, tor, toc,
+ TableGetCellValue(tablePtr, fromr, fromc));
+
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableGetIcursor --
+ * Parses the argument as an index into the active cell string.
+ * Recognises 'end', 'insert' or an integer. Constrains it to the
+ * size of the buffer. This acts like a "SetIcursor" when *posn is NULL.
+ *
+ * Results:
+ * If (posn != NULL), then it gets the cursor position.
+ *
+ * Side effects:
+ * Can move cursor position.
+ *
+ *----------------------------------------------------------------------
+ */
+int
+TableGetIcursor(Table *tablePtr, char *arg, int *posn)
+{
+ int tmp, len;
+
+ len = strlen(tablePtr->activeBuf);
+#ifdef TCL_UTF_MAX
+ /* Need to base it off strlen to account for \x00 (Unicode null) */
+ len = Tcl_NumUtfChars(tablePtr->activeBuf, len);
+#endif
+ /* ensure icursor didn't get out of sync */
+ if (tablePtr->icursor > len) tablePtr->icursor = len;
+ /* is this end */
+ if (strcmp(arg, "end") == 0) {
+ tmp = len;
+ } else if (strcmp(arg, "insert") == 0) {
+ tmp = tablePtr->icursor;
+ } else {
+ if (Tcl_GetInt(tablePtr->interp, arg, &tmp) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ CONSTRAIN(tmp, 0, len);
+ }
+ if (posn) {
+ *posn = tmp;
+ } else {
+ tablePtr->icursor = tmp;
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TableGetIndex --
+ * Parse an index into a table and return either its value
+ * or an error.
+ *
+ * Results:
+ * A standard Tcl result. If all went well, then *row,*col is
+ * filled in with the index corresponding to string. If an
+ * error occurs then an error message is left in interp result.
+ * The index returned is in user coords.
+ *
+ * Side effects:
+ * Sets row,col index to an appropriately constrained user index.
+ *
+ *--------------------------------------------------------------
+ */
+int
+TableGetIndex(tablePtr, str, row_p, col_p)
+ register Table *tablePtr; /* Table for which the index is being
+ * specified. */
+ char *str; /* Symbolic specification of cell in table. */
+ int *row_p; /* Where to store converted row. */
+ int *col_p; /* Where to store converted col. */
+{
+ int r, c, len = strlen(str);
+ char dummy;
+
+ /*
+ * Note that all of these values will be adjusted by row/ColOffset
+ */
+ if (str[0] == '@') { /* @x,y coordinate */
+ int x, y;
+
+ if (sscanf(str+1, "%d,%d%c", &x, &y, &dummy) != 2) {
+ /* Make sure it won't work for "2,3extrastuff" */
+ goto IndexError;
+ }
+ TableWhatCell(tablePtr, x, y, &r, &c);
+ r += tablePtr->rowOffset;
+ c += tablePtr->colOffset;
+ } else if (*str == '-' || isdigit(str[0])) {
+ if (sscanf(str, "%d,%d%c", &r, &c, &dummy) != 2) {
+ /* Make sure it won't work for "2,3extrastuff" */
+ goto IndexError;
+ }
+ /* ensure appropriate user index */
+ CONSTRAIN(r, tablePtr->rowOffset,
+ tablePtr->rows-1+tablePtr->rowOffset);
+ CONSTRAIN(c, tablePtr->colOffset,
+ tablePtr->cols-1+tablePtr->colOffset);
+ } else if (len > 1 && strncmp(str, "active", len) == 0 ) { /* active */
+ if (tablePtr->flags & HAS_ACTIVE) {
+ r = tablePtr->activeRow+tablePtr->rowOffset;
+ c = tablePtr->activeCol+tablePtr->colOffset;
+ } else {
+ Tcl_SetObjResult(tablePtr->interp,
+ Tcl_NewStringObj("no \"active\" cell in table", -1));
+ return TCL_ERROR;
+ }
+ } else if (len > 1 && strncmp(str, "anchor", len) == 0) { /* anchor */
+ if (tablePtr->flags & HAS_ANCHOR) {
+ r = tablePtr->anchorRow+tablePtr->rowOffset;
+ c = tablePtr->anchorCol+tablePtr->colOffset;
+ } else {
+ Tcl_SetObjResult(tablePtr->interp,
+ Tcl_NewStringObj("no \"anchor\" cell in table", -1));
+ return TCL_ERROR;
+ }
+ } else if (strncmp(str, "end", len) == 0) { /* end */
+ r = tablePtr->rows-1+tablePtr->rowOffset;
+ c = tablePtr->cols-1+tablePtr->colOffset;
+ } else if (strncmp(str, "origin", len) == 0) { /* origin */
+ r = tablePtr->titleRows+tablePtr->rowOffset;
+ c = tablePtr->titleCols+tablePtr->colOffset;
+ } else if (strncmp(str, "topleft", len) == 0) { /* topleft */
+ r = tablePtr->topRow+tablePtr->rowOffset;
+ c = tablePtr->leftCol+tablePtr->colOffset;
+ } else if (strncmp(str, "bottomright", len) == 0) { /* bottomright */
+ /*
+ * FIX: Should this avoid spans, or consider them in the bottomright?
+ tablePtr->flags |= AVOID_SPANS;
+ tablePtr->flags &= ~AVOID_SPANS;
+ */
+ TableGetLastCell(tablePtr, &r, &c);
+ r += tablePtr->rowOffset;
+ c += tablePtr->colOffset;
+ } else {
+ IndexError:
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(tablePtr->interp),
+ "bad table index \"", str, "\": must be active, anchor, end, ",
+ "origin, topleft, bottomright, @x,y, or ,",
+ (char *)NULL);
+ return TCL_ERROR;
+ }
+
+ /* Note: values are expected to be properly constrained
+ * as a user index by this point */
+ if (row_p) *row_p = r;
+ if (col_p) *col_p = c;
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Table_SetCmd --
+ * This procedure is invoked to process the set method
+ * that corresponds to a widget managed by this module.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+int
+Table_SetCmd(ClientData clientData, register Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[])
+{
+ register Table *tablePtr = (Table *)clientData;
+ int row, col, len, i, j, max;
+ char *str;
+
+ /* sets any number of tags/indices to a given value */
+ if (objc < 3) {
+ CMD_SET_USAGE:
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "?row|col? index ?value? ?index value ...?");
+ return TCL_ERROR;
+ }
+
+ /* make sure there is a data source to accept set */
+ if (tablePtr->dataSource == DATA_NONE) {
+ return TCL_OK;
+ }
+
+ str = Tcl_GetStringFromObj(objv[2], &len);
+ if (strncmp(str, "row", len) == 0 || strncmp(str, "col", len) == 0) {
+ Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
+ /* set row index list ?index list ...? */
+ if (objc < 4) {
+ goto CMD_SET_USAGE;
+ } else if (objc == 4) {
+ if (TableGetIndexObj(tablePtr, objv[3],
+ &row, &col) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (*str == 'r') {
+ max = tablePtr->cols+tablePtr->colOffset;
+ for (i=col; irows+tablePtr->rowOffset;
+ for (i=row; istate == STATE_NORMAL) {
+ int listc;
+ Tcl_Obj **listv;
+ /* make sure there are an even number of index/list pairs */
+ if (objc & 0) {
+ goto CMD_SET_USAGE;
+ }
+ for (i = 3; i < objc-1; i += 2) {
+ if ((TableGetIndexObj(tablePtr, objv[i],
+ &row, &col) != TCL_OK) ||
+ (Tcl_ListObjGetElements(interp, objv[i+1],
+ &listc, &listv) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ if (*str == 'r') {
+ max = col+MIN(tablePtr->cols+tablePtr->colOffset-col,
+ listc);
+ for (j = col; j < max; j++) {
+ if (TableSetCellValue(tablePtr, row, j,
+ Tcl_GetString(listv[j-col]))
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (row-tablePtr->rowOffset == tablePtr->activeRow &&
+ j-tablePtr->colOffset == tablePtr->activeCol) {
+ TableGetActiveBuf(tablePtr);
+ }
+ TableRefresh(tablePtr, row-tablePtr->rowOffset,
+ j-tablePtr->colOffset, CELL);
+ }
+ } else {
+ max = row+MIN(tablePtr->rows+tablePtr->rowOffset-row,
+ listc);
+ for (j = row; j < max; j++) {
+ if (TableSetCellValue(tablePtr, j, col,
+ Tcl_GetString(listv[j-row]))
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (j-tablePtr->rowOffset == tablePtr->activeRow &&
+ col-tablePtr->colOffset == tablePtr->activeCol) {
+ TableGetActiveBuf(tablePtr);
+ }
+ TableRefresh(tablePtr, j-tablePtr->rowOffset,
+ col-tablePtr->colOffset, CELL);
+ }
+ }
+ }
+ }
+ } else if (objc == 3) {
+ /* set index */
+ if (TableGetIndexObj(tablePtr, objv[2], &row, &col) != TCL_OK) {
+ return TCL_ERROR;
+ } else {
+ /*
+ * Cannot use Tcl_GetObjResult here because TableGetCellValue
+ * can corrupt the resultPtr.
+ */
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ TableGetCellValue(tablePtr, row, col),-1));
+ }
+ } else {
+ /* set index val ?index val ...? */
+ /* make sure there are an even number of index/value pairs */
+ if (objc & 1) {
+ goto CMD_SET_USAGE;
+ }
+ for (i = 2; i < objc-1; i += 2) {
+ if ((TableGetIndexObj(tablePtr, objv[i], &row, &col) != TCL_OK) ||
+ (TableSetCellValue(tablePtr, row, col,
+ Tcl_GetString(objv[i+1])) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ row -= tablePtr->rowOffset;
+ col -= tablePtr->colOffset;
+ if (row == tablePtr->activeRow && col == tablePtr->activeCol) {
+ TableGetActiveBuf(tablePtr);
+ }
+ TableRefresh(tablePtr, row, col, CELL);
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Table_SpanSet --
+ * Takes row,col in user coords and sets a span on the
+ * cell if possible
+ *
+ * Results:
+ * A standard Tcl result
+ *
+ * Side effects:
+ * The span can be constrained
+ *
+ *--------------------------------------------------------------
+ */
+static int
+Table_SpanSet(register Table *tablePtr, int urow, int ucol, int rs, int cs)
+{
+ Tcl_Interp *interp = tablePtr->interp;
+ int i, j, new, ors, ocs, result = TCL_OK;
+ int row, col;
+ Tcl_HashEntry *entryPtr;
+ Tcl_HashSearch search;
+ char *dbuf, buf[INDEX_BUFSIZE], cell[INDEX_BUFSIZE], span[INDEX_BUFSIZE];
+
+ row = urow - tablePtr->rowOffset;
+ col = ucol - tablePtr->colOffset;
+
+ TableMakeArrayIndex(urow, ucol, cell);
+
+ if (tablePtr->spanTbl == NULL) {
+ tablePtr->spanTbl = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
+ Tcl_InitHashTable(tablePtr->spanTbl, TCL_STRING_KEYS);
+ tablePtr->spanAffTbl = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
+ Tcl_InitHashTable(tablePtr->spanAffTbl, TCL_STRING_KEYS);
+ }
+
+ /* first check in the affected cells table */
+ if ((entryPtr=Tcl_FindHashEntry(tablePtr->spanAffTbl, cell)) != NULL) {
+ /* We have to make sure this was not already hidden
+ * that's an error */
+ if ((char *)Tcl_GetHashValue(entryPtr) != NULL) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "cannot set spanning on hidden cell ",
+ cell, (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+ /* do constraints on the spans
+ * title cells must not expand beyond the titles
+ * other cells can't expand negatively into title area
+ */
+ if ((row < tablePtr->titleRows) &&
+ (row + rs >= tablePtr->titleRows)) {
+ rs = tablePtr->titleRows - row - 1;
+ }
+ if ((col < tablePtr->titleCols) &&
+ (col + cs >= tablePtr->titleCols)) {
+ cs = tablePtr->titleCols - col - 1;
+ }
+ rs = MAX(0, rs);
+ cs = MAX(0, cs);
+
+ /* then work in the span cells table */
+ if ((entryPtr = Tcl_FindHashEntry(tablePtr->spanTbl, cell)) != NULL) {
+ /* We have to readjust for what was there first */
+ TableParseArrayIndex(&ors, &ocs, (char *)Tcl_GetHashValue(entryPtr));
+ ckfree((char *) Tcl_GetHashValue(entryPtr));
+ Tcl_DeleteHashEntry(entryPtr);
+ for (i = urow; i <= urow+ors; i++) {
+ for (j = ucol; j <= ucol+ocs; j++) {
+ TableMakeArrayIndex(i, j, buf);
+ entryPtr = Tcl_FindHashEntry(tablePtr->spanAffTbl, buf);
+ if (entryPtr != NULL) {
+ Tcl_DeleteHashEntry(entryPtr);
+ }
+ TableRefresh(tablePtr, i-tablePtr->rowOffset,
+ j-tablePtr->colOffset, CELL);
+ }
+ }
+ } else {
+ ors = ocs = 0;
+ }
+
+ /* calc to make sure that span is OK */
+ for (i = urow; i <= urow+rs; i++) {
+ for (j = ucol; j <= ucol+cs; j++) {
+ TableMakeArrayIndex(i, j, buf);
+ entryPtr = Tcl_FindHashEntry(tablePtr->spanAffTbl, buf);
+ if (entryPtr != NULL) {
+ /* Something already spans here */
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "cannot overlap already spanned cell ",
+ buf, (char *) NULL);
+ result = TCL_ERROR;
+ rs = ors;
+ cs = ocs;
+ break;
+ }
+ }
+ if (result == TCL_ERROR)
+ break;
+ }
+
+ /* 0,0 span means set to unspanned again */
+ if (rs == 0 && cs == 0) {
+ entryPtr = Tcl_FindHashEntry(tablePtr->spanTbl, cell);
+ if (entryPtr != NULL) {
+ ckfree((char *) Tcl_GetHashValue(entryPtr));
+ Tcl_DeleteHashEntry(entryPtr);
+ }
+ entryPtr = Tcl_FindHashEntry(tablePtr->spanAffTbl, cell);
+ if (entryPtr != NULL) {
+ Tcl_DeleteHashEntry(entryPtr);
+ }
+ if (Tcl_FirstHashEntry(tablePtr->spanTbl, &search) == NULL) {
+ /* There are no more spans, so delete tables to improve
+ * performance of TableCellCoords */
+ Tcl_DeleteHashTable(tablePtr->spanTbl);
+ ckfree((char *) (tablePtr->spanTbl));
+ Tcl_DeleteHashTable(tablePtr->spanAffTbl);
+ ckfree((char *) (tablePtr->spanAffTbl));
+ tablePtr->spanTbl = NULL;
+ tablePtr->spanAffTbl = NULL;
+ }
+ return result;
+ }
+
+ /* Make sure there is no extra stuff */
+ TableMakeArrayIndex(rs, cs, span);
+
+ /* Set affected cell table to a NULL value */
+ entryPtr = Tcl_CreateHashEntry(tablePtr->spanAffTbl, cell, &new);
+ Tcl_SetHashValue(entryPtr, (char *) NULL);
+ /* set the spanning cells table with span value */
+ entryPtr = Tcl_CreateHashEntry(tablePtr->spanTbl, cell, &new);
+ dbuf = (char *)ckalloc(strlen(span)+1);
+ strcpy(dbuf, span);
+ Tcl_SetHashValue(entryPtr, dbuf);
+ dbuf = Tcl_GetHashKey(tablePtr->spanTbl, entryPtr);
+ /* Set other affected cells */
+ EmbWinUnmap(tablePtr, row, row + rs, col, col + cs);
+ for (i = urow; i <= urow+rs; i++) {
+ for (j = ucol; j <= ucol+cs; j++) {
+ TableMakeArrayIndex(i, j, buf);
+ entryPtr = Tcl_CreateHashEntry(tablePtr->spanAffTbl, buf, &new);
+ if (!(i == urow && j == ucol)) {
+ Tcl_SetHashValue(entryPtr, (char *) dbuf);
+ }
+ }
+ }
+ TableRefresh(tablePtr, row, col, CELL);
+ return result;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Table_SpanCmd --
+ * This procedure is invoked to process the span method
+ * that corresponds to a widget managed by this module.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+int
+Table_SpanCmd(ClientData clientData, register Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[])
+{
+ register Table *tablePtr = (Table *) clientData;
+ int rs, cs, row, col, i;
+ Tcl_HashEntry *entryPtr;
+
+ if (objc < 2 || (objc > 4 && (objc&1))) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "?index? ?rows,cols index rows,cols ...?");
+ return TCL_ERROR;
+ }
+
+ if (objc == 2) {
+ if (tablePtr->spanTbl) {
+ Tcl_HashSearch search;
+ Tcl_Obj *objPtr, *resultPtr = Tcl_NewObj();
+
+ for (entryPtr = Tcl_FirstHashEntry(tablePtr->spanTbl, &search);
+ entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&search)) {
+ objPtr = Tcl_NewStringObj(Tcl_GetHashKey(tablePtr->spanTbl,
+ entryPtr), -1);
+ Tcl_ListObjAppendElement(NULL, resultPtr, objPtr);
+ objPtr = Tcl_NewStringObj((char *) Tcl_GetHashValue(entryPtr),
+ -1);
+ Tcl_ListObjAppendElement(NULL, resultPtr, objPtr);
+ }
+ Tcl_SetObjResult(interp, resultPtr);
+ }
+ return TCL_OK;
+ } else if (objc == 3) {
+ if (TableGetIndexObj(tablePtr, objv[2], &row, &col) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ /* Just return the spanning values of the one cell */
+ if (tablePtr->spanTbl &&
+ (entryPtr = Tcl_FindHashEntry(tablePtr->spanTbl,
+ Tcl_GetString(objv[2]))) != NULL) {
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj((char *)Tcl_GetHashValue(entryPtr), -1));
+ }
+ return TCL_OK;
+ } else {
+ for (i = 2; i < objc-1; i += 2) {
+ if (TableGetIndexObj(tablePtr, objv[i], &row, &col) == TCL_ERROR ||
+ (TableParseArrayIndex(&rs, &cs,
+ Tcl_GetString(objv[i+1])) != 2) ||
+ Table_SpanSet(tablePtr, row, col, rs, cs) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Table_HiddenCmd --
+ * This procedure is invoked to process the hidden method
+ * that corresponds to a widget managed by this module.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+int
+Table_HiddenCmd(ClientData clientData, register Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[])
+{
+ register Table *tablePtr = (Table *) clientData;
+ int i, row, col;
+ Tcl_HashEntry *entryPtr;
+ char *span;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?index? ?index ...?");
+ return TCL_ERROR;
+ }
+ if (tablePtr->spanTbl == NULL) {
+ /* Avoid the whole thing if we have no spans */
+ if (objc > 3) {
+ Tcl_SetBooleanObj(Tcl_GetObjResult(interp), 0);
+ }
+ return TCL_OK;
+ }
+ if (objc == 2) {
+ /* return all "hidden" cells */
+ Tcl_HashSearch search;
+ Tcl_Obj *objPtr = Tcl_NewObj();
+
+ for (entryPtr = Tcl_FirstHashEntry(tablePtr->spanAffTbl, &search);
+ entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&search)) {
+ if ((span = (char *) Tcl_GetHashValue(entryPtr)) == NULL) {
+ /* this is actually a spanning cell */
+ continue;
+ }
+ Tcl_ListObjAppendElement(NULL, objPtr,
+ Tcl_NewStringObj(Tcl_GetHashKey(tablePtr->spanAffTbl,
+ entryPtr), -1));
+ }
+ Tcl_SetObjResult(interp, TableCellSortObj(interp, objPtr));
+ return TCL_OK;
+ }
+ if (objc == 3) {
+ if (TableGetIndexObj(tablePtr, objv[2], &row, &col) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ /* Just return the spanning values of the one cell */
+ entryPtr = Tcl_FindHashEntry(tablePtr->spanAffTbl,
+ Tcl_GetString(objv[2]));
+ if (entryPtr != NULL &&
+ (span = (char *)Tcl_GetHashValue(entryPtr)) != NULL) {
+ /* this is a hidden cell */
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(span, -1));
+ }
+ return TCL_OK;
+ }
+ for (i = 2; i < objc; i++) {
+ if (TableGetIndexObj(tablePtr, objv[i], &row, &col) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ entryPtr = Tcl_FindHashEntry(tablePtr->spanAffTbl,
+ Tcl_GetString(objv[i]));
+ if (entryPtr != NULL &&
+ (char *)Tcl_GetHashValue(entryPtr) != NULL) {
+ /* this is a hidden cell */
+ continue;
+ }
+ /* We only reach here if it doesn't satisfy "hidden" criteria */
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
+ return TCL_OK;
+ }
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1));
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TableSpanSanCheck --
+ * This procedure is invoked by TableConfigure to make sure
+ * that spans are kept sane according to the docs.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * void.
+ *
+ * Side effects:
+ * Spans in title areas can be reconstrained.
+ *
+ *--------------------------------------------------------------
+ */
+void
+TableSpanSanCheck(register Table *tablePtr)
+{
+ int rs, cs, row, col, reset;
+ Tcl_HashEntry *entryPtr;
+ Tcl_HashSearch search;
+
+ if (tablePtr->spanTbl == NULL) {
+ return;
+ }
+
+ for (entryPtr = Tcl_FirstHashEntry(tablePtr->spanTbl, &search);
+ entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&search)) {
+ reset = 0;
+ TableParseArrayIndex(&row, &col,
+ Tcl_GetHashKey(tablePtr->spanTbl, entryPtr));
+ TableParseArrayIndex(&rs, &cs,
+ (char *) Tcl_GetHashValue(entryPtr));
+ if ((row-tablePtr->rowOffset < tablePtr->titleRows) &&
+ (row-tablePtr->rowOffset+rs >= tablePtr->titleRows)) {
+ rs = tablePtr->titleRows-(row-tablePtr->rowOffset)-1;
+ reset = 1;
+ }
+ if ((col-tablePtr->colOffset < tablePtr->titleCols) &&
+ (col-tablePtr->colOffset+cs >= tablePtr->titleCols)) {
+ cs = tablePtr->titleCols-(col-tablePtr->colOffset)-1;
+ reset = 1;
+ }
+ if (reset) {
+ Table_SpanSet(tablePtr, row, col, rs, cs);
+ }
+ }
+}
diff --git a/tktable/generic/tkTableCellSort.c b/tktable/generic/tkTableCellSort.c
new file mode 100644
index 0000000..b2a7837
--- /dev/null
+++ b/tktable/generic/tkTableCellSort.c
@@ -0,0 +1,400 @@
+/*
+ * tkTableCell.c --
+ *
+ * This module implements cell sort functions for table
+ * widgets. The MergeSort algorithm and other aux sorting
+ * functions were taken from tclCmdIL.c lsort command:
+
+ * tclCmdIL.c --
+ *
+ * This file contains the top-level command routines for most of
+ * the Tcl built-in commands whose names begin with the letters
+ * I through L. It contains only commands in the generic core
+ * (i.e. those that don't depend much upon UNIX facilities).
+ *
+ * Copyright (c) 1987-1993 The Regents of the University of California.
+ * Copyright (c) 1993-1997 Lucent Technologies.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
+
+ *
+ * Copyright (c) 1998-2002 Jeffrey Hobbs
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#include "tkTable.h"
+
+#ifndef UCHAR
+#define UCHAR(c) ((unsigned char) (c))
+#endif
+
+/*
+ * During execution of the "lsort" command, structures of the following
+ * type are used to arrange the objects being sorted into a collection
+ * of linked lists.
+ */
+
+typedef struct SortElement {
+ Tcl_Obj *objPtr; /* Object being sorted. */
+ struct SortElement *nextPtr; /* Next element in the list, or
+ * NULL for end of list. */
+} SortElement;
+
+static int TableSortCompareProc _ANSI_ARGS_((CONST VOID *first,
+ CONST VOID *second));
+static SortElement * MergeSort _ANSI_ARGS_((SortElement *headPt));
+static SortElement * MergeLists _ANSI_ARGS_((SortElement *leftPtr,
+ SortElement *rightPtr));
+static int DictionaryCompare _ANSI_ARGS_((char *left,
+ char *right));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableSortCompareProc --
+ * This procedure is invoked by qsort to determine the proper
+ * ordering between two elements.
+ *
+ * Results:
+ * < 0 means first is "smaller" than "second", > 0 means "first"
+ * is larger than "second", and 0 means they should be treated
+ * as equal.
+ *
+ * Side effects:
+ * None, unless a user-defined comparison command does something
+ * weird.
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+TableSortCompareProc(first, second)
+ CONST VOID *first, *second; /* Elements to be compared. */
+{
+ char *str1 = *((char **) first);
+ char *str2 = *((char **) second);
+
+ return DictionaryCompare(str1, str2);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableCellSort --
+ * Sort a list of table cell elements (of form row,col)
+ *
+ * Results:
+ * Returns the sorted list of elements. Because Tcl_Merge allocs
+ * the space for result, it must later be Tcl_Free'd by caller.
+ *
+ * Side effects:
+ * Behaviour undefined for ill-formed input list of elements.
+ *
+ *----------------------------------------------------------------------
+ */
+char *
+TableCellSort(Table *tablePtr, char *str)
+{
+ int listArgc;
+ CONST84 char **listArgv;
+ char *result;
+
+ if (Tcl_SplitList(tablePtr->interp, str, &listArgc, &listArgv) != TCL_OK) {
+ return str;
+ }
+ /* Thread safety: qsort is reportedly not thread-safe... */
+ qsort((VOID *) listArgv, (size_t) listArgc, sizeof (char *),
+ TableSortCompareProc);
+ result = Tcl_Merge(listArgc, listArgv);
+ ckfree((char *) listArgv);
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DictionaryCompare - Not the Unicode version
+ *
+ * This function compares two strings as if they were being used in
+ * an index or card catalog. The case of alphabetic characters is
+ * ignored, except to break ties. Thus "B" comes before "b" but
+ * after "a". Also, integers embedded in the strings compare in
+ * numerical order. In other words, "x10y" comes after "x9y", not
+ * before it as it would when using strcmp().
+ *
+ * Results:
+ * A negative result means that the first element comes before the
+ * second, and a positive result means that the second element
+ * should come first. A result of zero means the two elements
+ * are equal and it doesn't matter which comes first.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+DictionaryCompare(left, right)
+ char *left, *right; /* The strings to compare */
+{
+ int diff, zeros;
+ int secondaryDiff = 0;
+
+ while (1) {
+ if (isdigit(UCHAR(*right)) && isdigit(UCHAR(*left))) {
+ /*
+ * There are decimal numbers embedded in the two
+ * strings. Compare them as numbers, rather than
+ * strings. If one number has more leading zeros than
+ * the other, the number with more leading zeros sorts
+ * later, but only as a secondary choice.
+ */
+
+ zeros = 0;
+ while ((*right == '0') && (isdigit(UCHAR(right[1])))) {
+ right++;
+ zeros--;
+ }
+ while ((*left == '0') && (isdigit(UCHAR(left[1])))) {
+ left++;
+ zeros++;
+ }
+ if (secondaryDiff == 0) {
+ secondaryDiff = zeros;
+ }
+
+ /*
+ * The code below compares the numbers in the two
+ * strings without ever converting them to integers. It
+ * does this by first comparing the lengths of the
+ * numbers and then comparing the digit values.
+ */
+
+ diff = 0;
+ while (1) {
+ if (diff == 0) {
+ diff = UCHAR(*left) - UCHAR(*right);
+ }
+ right++;
+ left++;
+ if (!isdigit(UCHAR(*right))) {
+ if (isdigit(UCHAR(*left))) {
+ return 1;
+ } else {
+ /*
+ * The two numbers have the same length. See
+ * if their values are different.
+ */
+
+ if (diff != 0) {
+ return diff;
+ }
+ break;
+ }
+ } else if (!isdigit(UCHAR(*left))) {
+ return -1;
+ }
+ }
+ continue;
+ }
+ diff = UCHAR(*left) - UCHAR(*right);
+ if (diff) {
+ if (isupper(UCHAR(*left)) && islower(UCHAR(*right))) {
+ diff = UCHAR(tolower(*left)) - UCHAR(*right);
+ if (diff) {
+ return diff;
+ } else if (secondaryDiff == 0) {
+ secondaryDiff = -1;
+ }
+ } else if (isupper(UCHAR(*right)) && islower(UCHAR(*left))) {
+ diff = UCHAR(*left) - UCHAR(tolower(UCHAR(*right)));
+ if (diff) {
+ return diff;
+ } else if (secondaryDiff == 0) {
+ secondaryDiff = 1;
+ }
+ } else {
+ return diff;
+ }
+ }
+ if (*left == 0) {
+ break;
+ }
+ left++;
+ right++;
+ }
+ if (diff == 0) {
+ diff = secondaryDiff;
+ }
+ return diff;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MergeLists -
+ *
+ * This procedure combines two sorted lists of SortElement structures
+ * into a single sorted list.
+ *
+ * Results:
+ * The unified list of SortElement structures.
+ *
+ * Side effects:
+ * None, unless a user-defined comparison command does something
+ * weird.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static SortElement *
+MergeLists(leftPtr, rightPtr)
+ SortElement *leftPtr; /* First list to be merged; may be
+ * NULL. */
+ SortElement *rightPtr; /* Second list to be merged; may be
+ * NULL. */
+{
+ SortElement *headPtr;
+ SortElement *tailPtr;
+
+ if (leftPtr == NULL) {
+ return rightPtr;
+ }
+ if (rightPtr == NULL) {
+ return leftPtr;
+ }
+ if (DictionaryCompare(Tcl_GetString(leftPtr->objPtr),
+ Tcl_GetString(rightPtr->objPtr)) > 0) {
+ tailPtr = rightPtr;
+ rightPtr = rightPtr->nextPtr;
+ } else {
+ tailPtr = leftPtr;
+ leftPtr = leftPtr->nextPtr;
+ }
+ headPtr = tailPtr;
+ while ((leftPtr != NULL) && (rightPtr != NULL)) {
+ if (DictionaryCompare(Tcl_GetString(leftPtr->objPtr),
+ Tcl_GetString(rightPtr->objPtr)) > 0) {
+ tailPtr->nextPtr = rightPtr;
+ tailPtr = rightPtr;
+ rightPtr = rightPtr->nextPtr;
+ } else {
+ tailPtr->nextPtr = leftPtr;
+ tailPtr = leftPtr;
+ leftPtr = leftPtr->nextPtr;
+ }
+ }
+ if (leftPtr != NULL) {
+ tailPtr->nextPtr = leftPtr;
+ } else {
+ tailPtr->nextPtr = rightPtr;
+ }
+ return headPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MergeSort -
+ *
+ * This procedure sorts a linked list of SortElement structures
+ * use the merge-sort algorithm.
+ *
+ * Results:
+ * A pointer to the head of the list after sorting is returned.
+ *
+ * Side effects:
+ * None, unless a user-defined comparison command does something
+ * weird.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static SortElement *
+MergeSort(headPtr)
+ SortElement *headPtr; /* First element on the list */
+{
+ /*
+ * The subList array below holds pointers to temporary lists built
+ * during the merge sort. Element i of the array holds a list of
+ * length 2**i.
+ */
+
+# define NUM_LISTS 30
+ SortElement *subList[NUM_LISTS];
+ SortElement *elementPtr;
+ int i;
+
+ for(i = 0; i < NUM_LISTS; i++){
+ subList[i] = NULL;
+ }
+ while (headPtr != NULL) {
+ elementPtr = headPtr;
+ headPtr = headPtr->nextPtr;
+ elementPtr->nextPtr = 0;
+ for (i = 0; (i < NUM_LISTS) && (subList[i] != NULL); i++){
+ elementPtr = MergeLists(subList[i], elementPtr);
+ subList[i] = NULL;
+ }
+ if (i >= NUM_LISTS) {
+ i = NUM_LISTS-1;
+ }
+ subList[i] = elementPtr;
+ }
+ elementPtr = NULL;
+ for (i = 0; i < NUM_LISTS; i++){
+ elementPtr = MergeLists(subList[i], elementPtr);
+ }
+ return elementPtr;
+}
+
+#ifndef NO_SORT_CELLS
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableCellSortObj --
+ * Sorts a list of table cell elements (of form row,col) in place
+ *
+ * Results:
+ * Sorts list of elements in place.
+ *
+ * Side effects:
+ * Behaviour undefined for ill-formed input list of elements.
+ *
+ *----------------------------------------------------------------------
+ */
+Tcl_Obj *
+TableCellSortObj(Tcl_Interp *interp, Tcl_Obj *listObjPtr)
+{
+ int length, i;
+ Tcl_Obj *sortedObjPtr, **listObjPtrs;
+ SortElement *elementArray;
+ SortElement *elementPtr;
+
+ if (Tcl_ListObjGetElements(interp, listObjPtr,
+ &length, &listObjPtrs) != TCL_OK) {
+ return NULL;
+ }
+ if (length <= 0) {
+ return listObjPtr;
+ }
+
+ elementArray = (SortElement *) ckalloc(length * sizeof(SortElement));
+ for (i=0; i < length; i++){
+ elementArray[i].objPtr = listObjPtrs[i];
+ elementArray[i].nextPtr = &elementArray[i+1];
+ }
+ elementArray[length-1].nextPtr = NULL;
+ elementPtr = MergeSort(elementArray);
+ sortedObjPtr = Tcl_NewObj();
+ for (; elementPtr != NULL; elementPtr = elementPtr->nextPtr){
+ Tcl_ListObjAppendElement(NULL, sortedObjPtr, elementPtr->objPtr);
+ }
+ ckfree((char*) elementArray);
+
+ return sortedObjPtr;
+}
+#endif
diff --git a/tktable/generic/tkTableCmds.c b/tktable/generic/tkTableCmds.c
new file mode 100644
index 0000000..3668b01
--- /dev/null
+++ b/tktable/generic/tkTableCmds.c
@@ -0,0 +1,1306 @@
+/*
+ * tkTableCmds.c --
+ *
+ * This module implements general commands of a table widget,
+ * based on the major/minor command structure.
+ *
+ * Copyright (c) 1998-2002 Jeffrey Hobbs
+ *
+ * See the file "license.txt" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#include "tkTable.h"
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Table_ActivateCmd --
+ * This procedure is invoked to process the activate method
+ * that corresponds to a table widget managed by this module.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+int
+Table_ActivateCmd(ClientData clientData, register Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[])
+{
+ register Table *tablePtr = (Table *) clientData;
+ int result = TCL_OK;
+ int row, col, templen;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "index");
+ return TCL_ERROR;
+ } else if (Tcl_GetStringFromObj(objv[2], &templen), templen == 0) {
+ /*
+ * Test implementation to clear active cell (becroft)
+ */
+ tablePtr->flags &= ~HAS_ACTIVE;
+ tablePtr->flags |= ACTIVE_DISABLED;
+ tablePtr->activeRow = -1;
+ tablePtr->activeCol = -1;
+ TableAdjustActive(tablePtr);
+ TableConfigCursor(tablePtr);
+ } else if (TableGetIndexObj(tablePtr, objv[2], &row, &col) != TCL_OK) {
+ return TCL_ERROR;
+ } else {
+ int x, y, w, dummy;
+ char buf1[INDEX_BUFSIZE], buf2[INDEX_BUFSIZE];
+
+ /* convert to valid active index in real coords */
+ row -= tablePtr->rowOffset;
+ col -= tablePtr->colOffset;
+ /* we do this regardless, to avoid cell commit problems */
+ if ((tablePtr->flags & HAS_ACTIVE) &&
+ (tablePtr->flags & TEXT_CHANGED)) {
+ tablePtr->flags &= ~TEXT_CHANGED;
+ TableSetCellValue(tablePtr,
+ tablePtr->activeRow+tablePtr->rowOffset,
+ tablePtr->activeCol+tablePtr->colOffset,
+ tablePtr->activeBuf);
+ }
+ if (row != tablePtr->activeRow || col != tablePtr->activeCol) {
+ if (tablePtr->flags & HAS_ACTIVE) {
+ TableMakeArrayIndex(tablePtr->activeRow+tablePtr->rowOffset,
+ tablePtr->activeCol+tablePtr->colOffset,
+ buf1);
+ } else {
+ buf1[0] = '\0';
+ }
+ tablePtr->flags |= HAS_ACTIVE;
+ tablePtr->flags &= ~ACTIVE_DISABLED;
+ tablePtr->activeRow = row;
+ tablePtr->activeCol = col;
+ if (tablePtr->activeTagPtr != NULL) {
+ ckfree((char *) (tablePtr->activeTagPtr));
+ tablePtr->activeTagPtr = NULL;
+ }
+ TableAdjustActive(tablePtr);
+ TableConfigCursor(tablePtr);
+ if (!(tablePtr->flags & BROWSE_CMD) &&
+ tablePtr->browseCmd != NULL) {
+ Tcl_DString script;
+ tablePtr->flags |= BROWSE_CMD;
+ row = tablePtr->activeRow+tablePtr->rowOffset;
+ col = tablePtr->activeCol+tablePtr->colOffset;
+ TableMakeArrayIndex(row, col, buf2);
+ Tcl_DStringInit(&script);
+ ExpandPercents(tablePtr, tablePtr->browseCmd, row, col,
+ buf1, buf2, tablePtr->icursor, &script, 0);
+ result = Tcl_GlobalEval(interp, Tcl_DStringValue(&script));
+ if (result == TCL_OK || result == TCL_RETURN) {
+ Tcl_ResetResult(interp);
+ }
+ Tcl_DStringFree(&script);
+ tablePtr->flags &= ~BROWSE_CMD;
+ }
+ } else {
+ char *p = Tcl_GetString(objv[2]);
+
+ if ((tablePtr->activeTagPtr != NULL) && *p == '@' &&
+ !(tablePtr->flags & ACTIVE_DISABLED) &&
+ TableCellVCoords(tablePtr, row, col, &x, &y, &w, &dummy, 0)) {
+ /* we are clicking into the same cell
+ * If it was activated with @x,y indexing,
+ * find the closest char */
+ Tk_TextLayout textLayout;
+ TableTag *tagPtr = tablePtr->activeTagPtr;
+
+ /* no error checking because GetIndex did it for us */
+ p++;
+ x = strtol(p, &p, 0) - x - tablePtr->activeX;
+ p++;
+ y = strtol(p, &p, 0) - y - tablePtr->activeY;
+
+ textLayout = Tk_ComputeTextLayout(tagPtr->tkfont,
+ tablePtr->activeBuf, -1,
+ (tagPtr->wrap) ? w : 0,
+ tagPtr->justify, 0, &dummy, &dummy);
+
+ tablePtr->icursor = Tk_PointToChar(textLayout, x, y);
+ Tk_FreeTextLayout(textLayout);
+ TableRefresh(tablePtr, row, col, CELL|INV_FORCE);
+ }
+ }
+ tablePtr->flags |= HAS_ACTIVE;
+ }
+ return result;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Table_AdjustCmd --
+ * This procedure is invoked to process the width/height method
+ * that corresponds to a table widget managed by this module.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+int
+Table_AdjustCmd(ClientData clientData, register Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[])
+{
+ register Table *tablePtr = (Table *) clientData;
+ Tcl_HashEntry *entryPtr;
+ Tcl_HashSearch search;
+ Tcl_HashTable *hashTablePtr;
+ int i, widthType, dummy, value, posn, offset;
+ char buf1[INDEX_BUFSIZE];
+
+ widthType = (*(Tcl_GetString(objv[1])) == 'w');
+ /* changes the width/height of certain selected columns */
+ if (objc != 3 && (objc & 1)) {
+ Tcl_WrongNumArgs(interp, 2, objv, widthType ?
+ "?col? ?width col width ...?" :
+ "?row? ?height row height ...?");
+ return TCL_ERROR;
+ }
+ if (widthType) {
+ hashTablePtr = tablePtr->colWidths;
+ offset = tablePtr->colOffset;
+ } else {
+ hashTablePtr = tablePtr->rowHeights;
+ offset = tablePtr->rowOffset;
+ }
+
+ if (objc == 2) {
+ /* print out all the preset column widths or row heights */
+ entryPtr = Tcl_FirstHashEntry(hashTablePtr, &search);
+ while (entryPtr != NULL) {
+ posn = ((int) Tcl_GetHashKey(hashTablePtr, entryPtr)) + offset;
+ value = (int) Tcl_GetHashValue(entryPtr);
+ sprintf(buf1, "%d %d", posn, value);
+ /* OBJECTIFY */
+ Tcl_AppendElement(interp, buf1);
+ entryPtr = Tcl_NextHashEntry(&search);
+ }
+ } else if (objc == 3) {
+ /* get the width/height of a particular row/col */
+ if (Tcl_GetIntFromObj(interp, objv[2], &posn) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ /* no range check is done, why bother? */
+ posn -= offset;
+ entryPtr = Tcl_FindHashEntry(hashTablePtr, (char *) posn);
+ if (entryPtr != NULL) {
+ Tcl_SetIntObj(Tcl_GetObjResult(interp),
+ (int) Tcl_GetHashValue(entryPtr));
+ } else {
+ Tcl_SetIntObj(Tcl_GetObjResult(interp), widthType ?
+ tablePtr->defColWidth : tablePtr->defRowHeight);
+ }
+ } else {
+ for (i=2; i 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "first ?last?");
+ return TCL_ERROR;
+ } else if (TableGetIndexObj(tablePtr, objv[2], &row, &col) == TCL_ERROR ||
+ (objc == 4 &&
+ TableGetIndexObj(tablePtr, objv[3], &x, &y) == TCL_ERROR)) {
+ return TCL_ERROR;
+ }
+
+ resultPtr = Tcl_GetObjResult(interp);
+ if (objc == 3) {
+ row -= tablePtr->rowOffset; col -= tablePtr->colOffset;
+ if (TableCellVCoords(tablePtr, row, col, &x, &y, &w, &h, 0)) {
+ Tcl_ListObjAppendElement(NULL, resultPtr, Tcl_NewIntObj(x));
+ Tcl_ListObjAppendElement(NULL, resultPtr, Tcl_NewIntObj(y));
+ Tcl_ListObjAppendElement(NULL, resultPtr, Tcl_NewIntObj(w));
+ Tcl_ListObjAppendElement(NULL, resultPtr, Tcl_NewIntObj(h));
+ }
+ return TCL_OK;
+ } else {
+ int r1, c1, r2, c2, minX = 99999, minY = 99999, maxX = 0, maxY = 0;
+
+ row -= tablePtr->rowOffset; col -= tablePtr->colOffset;
+ x -= tablePtr->rowOffset; y -= tablePtr->colOffset;
+ r1 = MIN(row,x); r2 = MAX(row,x);
+ c1 = MIN(col,y); c2 = MAX(col,y);
+ key = 0;
+ for (row = r1; row <= r2; row++) {
+ for (col = c1; col <= c2; col++) {
+ if (TableCellVCoords(tablePtr, row, col, &x, &y, &w, &h, 0)) {
+ /* Get max bounding box */
+ if (x < minX) minX = x;
+ if (y < minY) minY = y;
+ if (x+w > maxX) maxX = x+w;
+ if (y+h > maxY) maxY = y+h;
+ key++;
+ }
+ }
+ }
+ if (key) {
+ Tcl_ListObjAppendElement(NULL, resultPtr, Tcl_NewIntObj(minX));
+ Tcl_ListObjAppendElement(NULL, resultPtr, Tcl_NewIntObj(minY));
+ Tcl_ListObjAppendElement(NULL, resultPtr,
+ Tcl_NewIntObj(maxX-minX));
+ Tcl_ListObjAppendElement(NULL, resultPtr,
+ Tcl_NewIntObj(maxY-minY));
+ }
+ }
+ return TCL_OK;
+}
+
+static CONST84 char *bdCmdNames[] = {
+ "mark", "dragto", (char *)NULL
+};
+enum bdCmd {
+ BD_MARK, BD_DRAGTO
+};
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Table_BorderCmd --
+ * This procedure is invoked to process the bbox method
+ * that corresponds to a table widget managed by this module.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+int
+Table_BorderCmd(ClientData clientData, register Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[])
+{
+ register Table *tablePtr = (Table *) clientData;
+ Tcl_HashEntry *entryPtr;
+ int x, y, w, h, row, col, key, dummy, value, cmdIndex;
+ char *rc = NULL;
+ Tcl_Obj *objPtr, *resultPtr;
+
+ if (objc < 5 || objc > 6) {
+ Tcl_WrongNumArgs(interp, 2, objv, "mark|dragto x y ?row|col?");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[2], bdCmdNames,
+ "option", 0, &cmdIndex) != TCL_OK ||
+ Tcl_GetIntFromObj(interp, objv[3], &x) != TCL_OK ||
+ Tcl_GetIntFromObj(interp, objv[4], &y) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (objc == 6) {
+ rc = Tcl_GetStringFromObj(objv[5], &w);
+ if ((w < 1) || (strncmp(rc, "row", w) && strncmp(rc, "col", w))) {
+ Tcl_WrongNumArgs(interp, 2, objv, "mark|dragto x y ?row|col?");
+ return TCL_ERROR;
+ }
+ }
+
+ resultPtr = Tcl_GetObjResult(interp);
+ switch ((enum bdCmd) cmdIndex) {
+ case BD_MARK:
+ /* Use x && y to determine if we are over a border */
+ value = TableAtBorder(tablePtr, x, y, &row, &col);
+ /* Cache the row && col for use in DRAGTO */
+ tablePtr->scanMarkRow = row;
+ tablePtr->scanMarkCol = col;
+ if (!value) {
+ return TCL_OK;
+ }
+ TableCellCoords(tablePtr, row, col, &x, &y, &dummy, &dummy);
+ tablePtr->scanMarkX = x;
+ tablePtr->scanMarkY = y;
+ if (objc == 5 || *rc == 'r') {
+ if (row < 0) {
+ objPtr = Tcl_NewStringObj("", 0);
+ } else {
+ objPtr = Tcl_NewIntObj(row+tablePtr->rowOffset);
+ }
+ Tcl_ListObjAppendElement(NULL, resultPtr, objPtr);
+ }
+ if (objc == 5 || *rc == 'c') {
+ if (col < 0) {
+ objPtr = Tcl_NewStringObj("", 0);
+ } else {
+ objPtr = Tcl_NewIntObj(col+tablePtr->colOffset);
+ }
+ Tcl_ListObjAppendElement(NULL, resultPtr, objPtr);
+ }
+ return TCL_OK; /* BORDER MARK */
+
+ case BD_DRAGTO:
+ /* check to see if we want to resize any borders */
+ if (tablePtr->resize == SEL_NONE) { return TCL_OK; }
+ row = tablePtr->scanMarkRow;
+ col = tablePtr->scanMarkCol;
+ TableCellCoords(tablePtr, row, col, &w, &h, &dummy, &dummy);
+ key = 0;
+ if (row >= 0 && (tablePtr->resize & SEL_ROW)) {
+ /* row border was active, move it */
+ value = y-h;
+ if (value < -1) value = -1;
+ if (value != tablePtr->scanMarkY) {
+ entryPtr = Tcl_CreateHashEntry(tablePtr->rowHeights,
+ (char *) row, &dummy);
+ /* -value means rowHeight will be interp'd as pixels, not
+ lines */
+ Tcl_SetHashValue(entryPtr, (ClientData) MIN(0,-value));
+ tablePtr->scanMarkY = value;
+ key++;
+ }
+ }
+ if (col >= 0 && (tablePtr->resize & SEL_COL)) {
+ /* col border was active, move it */
+ value = x-w;
+ if (value < -1) value = -1;
+ if (value != tablePtr->scanMarkX) {
+ entryPtr = Tcl_CreateHashEntry(tablePtr->colWidths,
+ (char *) col, &dummy);
+ /* -value means colWidth will be interp'd as pixels, not
+ chars */
+ Tcl_SetHashValue(entryPtr, (ClientData) MIN(0,-value));
+ tablePtr->scanMarkX = value;
+ key++;
+ }
+ }
+ /* Only if something changed do we want to update */
+ if (key) {
+ TableAdjustParams(tablePtr);
+ /* Only rerequest geometry if the basis is the #rows &| #cols */
+ if (tablePtr->maxReqCols || tablePtr->maxReqRows)
+ TableGeometryRequest(tablePtr);
+ TableInvalidateAll(tablePtr, 0);
+ }
+ return TCL_OK; /* BORDER DRAGTO */
+ }
+ return TCL_OK;
+}
+
+/* clear subcommands */
+static CONST84 char *clearNames[] = {
+ "all", "cache", "sizes", "tags", (char *)NULL
+};
+enum clearCommand {
+ CLEAR_ALL, CLEAR_CACHE, CLEAR_SIZES, CLEAR_TAGS
+};
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Table_ClearCmd --
+ * This procedure is invoked to process the clear method
+ * that corresponds to a table widget managed by this module.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * Cached info can be lost. Returns valid Tcl result.
+ *
+ * Side effects:
+ * Can cause redraw.
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+int
+Table_ClearCmd(ClientData clientData, register Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[])
+{
+ register Table *tablePtr = (Table *) clientData;
+ int cmdIndex, redraw = 0;
+
+ if (objc < 3 || objc > 5) {
+ Tcl_WrongNumArgs(interp, 2, objv, "option ?first? ?last?");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[2], clearNames,
+ "clear option", 0, &cmdIndex) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (objc == 3) {
+ if (cmdIndex == CLEAR_TAGS || cmdIndex == CLEAR_ALL) {
+ Tcl_DeleteHashTable(tablePtr->rowStyles);
+ Tcl_DeleteHashTable(tablePtr->colStyles);
+ Tcl_DeleteHashTable(tablePtr->cellStyles);
+ Tcl_DeleteHashTable(tablePtr->flashCells);
+ Tcl_DeleteHashTable(tablePtr->selCells);
+
+ /* style hash tables */
+ Tcl_InitHashTable(tablePtr->rowStyles, TCL_ONE_WORD_KEYS);
+ Tcl_InitHashTable(tablePtr->colStyles, TCL_ONE_WORD_KEYS);
+ Tcl_InitHashTable(tablePtr->cellStyles, TCL_STRING_KEYS);
+
+ /* special style hash tables */
+ Tcl_InitHashTable(tablePtr->flashCells, TCL_STRING_KEYS);
+ Tcl_InitHashTable(tablePtr->selCells, TCL_STRING_KEYS);
+ }
+
+ if (cmdIndex == CLEAR_SIZES || cmdIndex == CLEAR_ALL) {
+ Tcl_DeleteHashTable(tablePtr->colWidths);
+ Tcl_DeleteHashTable(tablePtr->rowHeights);
+
+ /* style hash tables */
+ Tcl_InitHashTable(tablePtr->colWidths, TCL_ONE_WORD_KEYS);
+ Tcl_InitHashTable(tablePtr->rowHeights, TCL_ONE_WORD_KEYS);
+ }
+
+ if (cmdIndex == CLEAR_CACHE || cmdIndex == CLEAR_ALL) {
+ Table_ClearHashTable(tablePtr->cache);
+ Tcl_InitHashTable(tablePtr->cache, TCL_STRING_KEYS);
+ /* If we were caching and we have no other data source,
+ * invalidate all the cells */
+ if (tablePtr->dataSource == DATA_CACHE) {
+ TableGetActiveBuf(tablePtr);
+ }
+ }
+ redraw = 1;
+ } else {
+ int row, col, r1, r2, c1, c2;
+ Tcl_HashEntry *entryPtr;
+ char buf[INDEX_BUFSIZE], *value;
+
+ if (TableGetIndexObj(tablePtr, objv[3], &row, &col) != TCL_OK ||
+ ((objc == 5) &&
+ TableGetIndexObj(tablePtr, objv[4], &r2, &c2) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ if (objc == 4) {
+ r1 = r2 = row;
+ c1 = c2 = col;
+ } else {
+ r1 = MIN(row,r2); r2 = MAX(row,r2);
+ c1 = MIN(col,c2); c2 = MAX(col,c2);
+ }
+ for (row = r1; row <= r2; row++) {
+ /* Note that *Styles entries are user based (no offset)
+ * while size entries are 0-based (real) */
+ if ((cmdIndex == CLEAR_TAGS || cmdIndex == CLEAR_ALL) &&
+ (entryPtr = Tcl_FindHashEntry(tablePtr->rowStyles,
+ (char *) row))) {
+ Tcl_DeleteHashEntry(entryPtr);
+ redraw = 1;
+ }
+
+ if ((cmdIndex == CLEAR_SIZES || cmdIndex == CLEAR_ALL) &&
+ (entryPtr = Tcl_FindHashEntry(tablePtr->rowHeights,
+ (char *) row-tablePtr->rowOffset))) {
+ Tcl_DeleteHashEntry(entryPtr);
+ redraw = 1;
+ }
+
+ for (col = c1; col <= c2; col++) {
+ TableMakeArrayIndex(row, col, buf);
+
+ if (cmdIndex == CLEAR_TAGS || cmdIndex == CLEAR_ALL) {
+ if ((row == r1) &&
+ (entryPtr = Tcl_FindHashEntry(tablePtr->colStyles,
+ (char *) col))) {
+ Tcl_DeleteHashEntry(entryPtr);
+ redraw = 1;
+ }
+ if ((entryPtr = Tcl_FindHashEntry(tablePtr->cellStyles,
+ buf))) {
+ Tcl_DeleteHashEntry(entryPtr);
+ redraw = 1;
+ }
+ if ((entryPtr = Tcl_FindHashEntry(tablePtr->flashCells,
+ buf))) {
+ Tcl_DeleteHashEntry(entryPtr);
+ redraw = 1;
+ }
+ if ((entryPtr = Tcl_FindHashEntry(tablePtr->selCells,
+ buf))) {
+ Tcl_DeleteHashEntry(entryPtr);
+ redraw = 1;
+ }
+ }
+
+ if ((cmdIndex == CLEAR_SIZES || cmdIndex == CLEAR_ALL) &&
+ row == r1 &&
+ (entryPtr = Tcl_FindHashEntry(tablePtr->colWidths, (char *)
+ col-tablePtr->colOffset))) {
+ Tcl_DeleteHashEntry(entryPtr);
+ redraw = 1;
+ }
+
+ if ((cmdIndex == CLEAR_CACHE || cmdIndex == CLEAR_ALL) &&
+ (entryPtr = Tcl_FindHashEntry(tablePtr->cache, buf))) {
+ value = (char *) Tcl_GetHashValue(entryPtr);
+ if (value) { ckfree(value); }
+ Tcl_DeleteHashEntry(entryPtr);
+ /* if the cache is our data source,
+ * we need to invalidate the cells changed */
+ if ((tablePtr->dataSource == DATA_CACHE) &&
+ (row-tablePtr->rowOffset == tablePtr->activeRow &&
+ col-tablePtr->colOffset == tablePtr->activeCol))
+ TableGetActiveBuf(tablePtr);
+ redraw = 1;
+ }
+ }
+ }
+ }
+ /* This could be more sensitive about what it updates,
+ * but that can actually be a lot more costly in some cases */
+ if (redraw) {
+ if (cmdIndex == CLEAR_SIZES || cmdIndex == CLEAR_ALL) {
+ TableAdjustParams(tablePtr);
+ /* rerequest geometry */
+ TableGeometryRequest(tablePtr);
+ }
+ TableInvalidateAll(tablePtr, 0);
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Table_CurselectionCmd --
+ * This procedure is invoked to process the bbox method
+ * that corresponds to a table widget managed by this module.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+int
+Table_CurselectionCmd(ClientData clientData, register Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[])
+{
+ register Table *tablePtr = (Table *) clientData;
+ Tcl_HashEntry *entryPtr;
+ Tcl_HashSearch search;
+ char *value = NULL;
+ int row, col;
+
+ if (objc > 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?value?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ /* make sure there is a data source to accept a set value */
+ if ((tablePtr->state == STATE_DISABLED) ||
+ (tablePtr->dataSource == DATA_NONE)) {
+ return TCL_OK;
+ }
+ value = Tcl_GetString(objv[2]);
+ for (entryPtr = Tcl_FirstHashEntry(tablePtr->selCells, &search);
+ entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&search)) {
+ TableParseArrayIndex(&row, &col,
+ Tcl_GetHashKey(tablePtr->selCells, entryPtr));
+ TableSetCellValue(tablePtr, row, col, value);
+ row -= tablePtr->rowOffset;
+ col -= tablePtr->colOffset;
+ if (row == tablePtr->activeRow && col == tablePtr->activeCol) {
+ TableGetActiveBuf(tablePtr);
+ }
+ TableRefresh(tablePtr, row, col, CELL);
+ }
+ } else {
+ Tcl_Obj *objPtr = Tcl_NewObj();
+
+ for (entryPtr = Tcl_FirstHashEntry(tablePtr->selCells, &search);
+ entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&search)) {
+ value = Tcl_GetHashKey(tablePtr->selCells, entryPtr);
+ Tcl_ListObjAppendElement(NULL, objPtr,
+ Tcl_NewStringObj(value, -1));
+ }
+ Tcl_SetObjResult(interp, TableCellSortObj(interp, objPtr));
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Table_CurvalueCmd --
+ * This procedure is invoked to process the curvalue method
+ * that corresponds to a table widget managed by this module.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+int
+Table_CurvalueCmd(ClientData clientData, register Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[])
+{
+ register Table *tablePtr = (Table *) clientData;
+
+ if (objc > 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "??");
+ return TCL_ERROR;
+ } else if (!(tablePtr->flags & HAS_ACTIVE)) {
+ return TCL_OK;
+ }
+
+ if (objc == 3) {
+ char *value;
+ int len;
+
+ value = Tcl_GetStringFromObj(objv[2], &len);
+ if (STREQ(value, tablePtr->activeBuf)) {
+ Tcl_SetObjResult(interp, objv[2]);
+ return TCL_OK;
+ }
+ /* validate potential new active buffer contents
+ * only accept if validation returns acceptance. */
+ if (tablePtr->validate &&
+ TableValidateChange(tablePtr,
+ tablePtr->activeRow+tablePtr->rowOffset,
+ tablePtr->activeCol+tablePtr->colOffset,
+ tablePtr->activeBuf,
+ value, tablePtr->icursor) != TCL_OK) {
+ return TCL_OK;
+ }
+ tablePtr->activeBuf = (char *)ckrealloc(tablePtr->activeBuf, len+1);
+ strcpy(tablePtr->activeBuf, value);
+ /* mark the text as changed */
+ tablePtr->flags |= TEXT_CHANGED;
+ TableSetActiveIndex(tablePtr);
+ /* check for possible adjustment of icursor */
+ TableGetIcursor(tablePtr, "insert", (int *)0);
+ TableRefresh(tablePtr, tablePtr->activeRow, tablePtr->activeCol, CELL);
+ }
+
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(tablePtr->activeBuf, -1));
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Table_GetCmd --
+ * This procedure is invoked to process the bbox method
+ * that corresponds to a table widget managed by this module.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+int
+Table_GetCmd(ClientData clientData, register Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[])
+{
+ register Table *tablePtr = (Table *) clientData;
+ int result = TCL_OK;
+ int r1, c1, r2, c2, row, col;
+
+ if (objc < 3 || objc > 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "first ?last?");
+ result = TCL_ERROR;
+ } else if (TableGetIndexObj(tablePtr, objv[2], &row, &col) == TCL_ERROR) {
+ result = TCL_ERROR;
+ } else if (objc == 3) {
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj(TableGetCellValue(tablePtr, row, col), -1));
+ } else if (TableGetIndexObj(tablePtr, objv[3], &r2, &c2) == TCL_ERROR) {
+ result = TCL_ERROR;
+ } else {
+ Tcl_Obj *objPtr = Tcl_NewObj();
+
+ r1 = MIN(row,r2); r2 = MAX(row,r2);
+ c1 = MIN(col,c2); c2 = MAX(col,c2);
+ for ( row = r1; row <= r2; row++ ) {
+ for ( col = c1; col <= c2; col++ ) {
+ Tcl_ListObjAppendElement(NULL, objPtr,
+ Tcl_NewStringObj(TableGetCellValue(tablePtr,
+ row, col), -1));
+ }
+ }
+ Tcl_SetObjResult(interp, objPtr);
+ }
+ return result;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Table_ScanCmd --
+ * This procedure is invoked to process the scan method
+ * that corresponds to a table widget managed by this module.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+int
+Table_ScanCmd(ClientData clientData, register Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[])
+{
+ register Table *tablePtr = (Table *) clientData;
+ int x, y, row, col, cmdIndex;
+
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 2, objv, "mark|dragto x y");
+ return TCL_ERROR;
+ } else if (Tcl_GetIndexFromObj(interp, objv[2], bdCmdNames,
+ "option", 0, &cmdIndex) != TCL_OK ||
+ Tcl_GetIntFromObj(interp, objv[3], &x) == TCL_ERROR ||
+ Tcl_GetIntFromObj(interp, objv[4], &y) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ switch ((enum bdCmd) cmdIndex) {
+ case BD_MARK:
+ TableWhatCell(tablePtr, x, y, &row, &col);
+ tablePtr->scanMarkRow = row-tablePtr->topRow;
+ tablePtr->scanMarkCol = col-tablePtr->leftCol;
+ tablePtr->scanMarkX = x;
+ tablePtr->scanMarkY = y;
+ break;
+
+ case BD_DRAGTO: {
+ int oldTop = tablePtr->topRow, oldLeft = tablePtr->leftCol;
+ y += (5*(y-tablePtr->scanMarkY));
+ x += (5*(x-tablePtr->scanMarkX));
+
+ TableWhatCell(tablePtr, x, y, &row, &col);
+
+ /* maintain appropriate real index */
+ tablePtr->topRow = BETWEEN(row-tablePtr->scanMarkRow,
+ tablePtr->titleRows, tablePtr->rows-1);
+ tablePtr->leftCol = BETWEEN(col-tablePtr->scanMarkCol,
+ tablePtr->titleCols, tablePtr->cols-1);
+
+ /* Adjust the table if new top left */
+ if (oldTop != tablePtr->topRow || oldLeft != tablePtr->leftCol) {
+ TableAdjustParams(tablePtr);
+ }
+ break;
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Table_SelAnchorCmd --
+ * This procedure is invoked to process the selection anchor method
+ * that corresponds to a table widget managed by this module.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+int
+Table_SelAnchorCmd(ClientData clientData, register Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[])
+{
+ register Table *tablePtr = (Table *) clientData;
+ int row, col;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 3, objv, "index");
+ return TCL_ERROR;
+ } else if (TableGetIndexObj(tablePtr, objv[3], &row, &col) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ tablePtr->flags |= HAS_ANCHOR;
+ /* maintain appropriate real index */
+ if (tablePtr->selectTitles) {
+ tablePtr->anchorRow = BETWEEN(row-tablePtr->rowOffset,
+ 0, tablePtr->rows-1);
+ tablePtr->anchorCol = BETWEEN(col-tablePtr->colOffset,
+ 0, tablePtr->cols-1);
+ } else {
+ tablePtr->anchorRow = BETWEEN(row-tablePtr->rowOffset,
+ tablePtr->titleRows, tablePtr->rows-1);
+ tablePtr->anchorCol = BETWEEN(col-tablePtr->colOffset,
+ tablePtr->titleCols, tablePtr->cols-1);
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Table_SelClearCmd --
+ * This procedure is invoked to process the selection clear method
+ * that corresponds to a table widget managed by this module.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+int
+Table_SelClearCmd(ClientData clientData, register Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[])
+{
+ register Table *tablePtr = (Table *) clientData;
+ int result = TCL_OK;
+ char buf1[INDEX_BUFSIZE];
+ int row, col, key, clo=0,chi=0,r1,c1,r2,c2;
+ Tcl_HashEntry *entryPtr;
+
+ if (objc < 4 || objc > 5) {
+ Tcl_WrongNumArgs(interp, 3, objv, "all| ??");
+ return TCL_ERROR;
+ }
+ if (STREQ(Tcl_GetString(objv[3]), "all")) {
+ Tcl_HashSearch search;
+ for(entryPtr = Tcl_FirstHashEntry(tablePtr->selCells, &search);
+ entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&search)) {
+ TableParseArrayIndex(&row, &col,
+ Tcl_GetHashKey(tablePtr->selCells,entryPtr));
+ Tcl_DeleteHashEntry(entryPtr);
+ TableRefresh(tablePtr, row-tablePtr->rowOffset,
+ col-tablePtr->colOffset, CELL);
+ }
+ return TCL_OK;
+ }
+ if (TableGetIndexObj(tablePtr, objv[3], &row, &col) == TCL_ERROR ||
+ (objc==5 &&
+ TableGetIndexObj(tablePtr, objv[4], &r2, &c2) == TCL_ERROR)) {
+ return TCL_ERROR;
+ }
+ key = 0;
+ if (objc == 4) {
+ r1 = r2 = row;
+ c1 = c2 = col;
+ } else {
+ r1 = MIN(row,r2); r2 = MAX(row,r2);
+ c1 = MIN(col,c2); c2 = MAX(col,c2);
+ }
+ switch (tablePtr->selectType) {
+ case SEL_BOTH:
+ clo = c1; chi = c2;
+ c1 = tablePtr->colOffset;
+ c2 = tablePtr->cols-1+c1;
+ key = 1;
+ goto CLEAR_CELLS;
+ CLEAR_BOTH:
+ key = 0;
+ c1 = clo; c2 = chi;
+ case SEL_COL:
+ r1 = tablePtr->rowOffset;
+ r2 = tablePtr->rows-1+r1;
+ break;
+ case SEL_ROW:
+ c1 = tablePtr->colOffset;
+ c2 = tablePtr->cols-1+c1;
+ break;
+ }
+ /* row/col are in user index coords */
+CLEAR_CELLS:
+ for ( row = r1; row <= r2; row++ ) {
+ for ( col = c1; col <= c2; col++ ) {
+ TableMakeArrayIndex(row, col, buf1);
+ entryPtr = Tcl_FindHashEntry(tablePtr->selCells, buf1);
+ if (entryPtr != NULL) {
+ Tcl_DeleteHashEntry(entryPtr);
+ TableRefresh(tablePtr, row-tablePtr->rowOffset,
+ col-tablePtr->colOffset, CELL);
+ }
+ }
+ }
+ if (key) goto CLEAR_BOTH;
+ return result;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Table_SelIncludesCmd --
+ * This procedure is invoked to process the selection includes method
+ * that corresponds to a table widget managed by this module.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+int
+Table_SelIncludesCmd(ClientData clientData, register Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[])
+{
+ register Table *tablePtr = (Table *) clientData;
+ int row, col;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 3, objv, "index");
+ return TCL_ERROR;
+ } else if (TableGetIndexObj(tablePtr, objv[3], &row, &col) == TCL_ERROR) {
+ return TCL_ERROR;
+ } else {
+ char buf[INDEX_BUFSIZE];
+ TableMakeArrayIndex(row, col, buf);
+ Tcl_SetBooleanObj(Tcl_GetObjResult(interp),
+ (Tcl_FindHashEntry(tablePtr->selCells, buf)!=NULL));
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Table_SelSetCmd --
+ * This procedure is invoked to process the selection set method
+ * that corresponds to a table widget managed by this module.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+int
+Table_SelSetCmd(ClientData clientData, register Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[])
+{
+ register Table *tablePtr = (Table *) clientData;
+ int row, col, dummy, key;
+ char buf1[INDEX_BUFSIZE];
+ Tcl_HashSearch search;
+ Tcl_HashEntry *entryPtr;
+
+ int clo=0, chi=0, r1, c1, r2, c2, firstRow, firstCol, lastRow, lastCol;
+ if (objc < 4 || objc > 5) {
+ Tcl_WrongNumArgs(interp, 3, objv, "first ?last?");
+ return TCL_ERROR;
+ }
+ if (TableGetIndexObj(tablePtr, objv[3], &row, &col) == TCL_ERROR ||
+ (objc==5 &&
+ TableGetIndexObj(tablePtr, objv[4], &r2, &c2) == TCL_ERROR)) {
+ return TCL_ERROR;
+ }
+ key = 0;
+ lastRow = tablePtr->rows-1+tablePtr->rowOffset;
+ lastCol = tablePtr->cols-1+tablePtr->colOffset;
+ if (tablePtr->selectTitles) {
+ firstRow = tablePtr->rowOffset;
+ firstCol = tablePtr->colOffset;
+ } else {
+ firstRow = tablePtr->titleRows+tablePtr->rowOffset;
+ firstCol = tablePtr->titleCols+tablePtr->colOffset;
+ }
+ /* maintain appropriate user index */
+ CONSTRAIN(row, firstRow, lastRow);
+ CONSTRAIN(col, firstCol, lastCol);
+ if (objc == 4) {
+ r1 = r2 = row;
+ c1 = c2 = col;
+ } else {
+ CONSTRAIN(r2, firstRow, lastRow);
+ CONSTRAIN(c2, firstCol, lastCol);
+ r1 = MIN(row,r2); r2 = MAX(row,r2);
+ c1 = MIN(col,c2); c2 = MAX(col,c2);
+ }
+ switch (tablePtr->selectType) {
+ case SEL_BOTH:
+ if (firstCol > lastCol) c2--; /* No selectable columns in table */
+ if (firstRow > lastRow) r2--; /* No selectable rows in table */
+ clo = c1; chi = c2;
+ c1 = firstCol;
+ c2 = lastCol;
+ key = 1;
+ goto SET_CELLS;
+ SET_BOTH:
+ key = 0;
+ c1 = clo; c2 = chi;
+ case SEL_COL:
+ r1 = firstRow;
+ r2 = lastRow;
+ if (firstCol > lastCol) c2--; /* No selectable columns in table */
+ break;
+ case SEL_ROW:
+ c1 = firstCol;
+ c2 = lastCol;
+ if (firstRow>lastRow) r2--; /* No selectable rows in table */
+ break;
+ }
+SET_CELLS:
+ entryPtr = Tcl_FirstHashEntry(tablePtr->selCells, &search);
+ for ( row = r1; row <= r2; row++ ) {
+ for ( col = c1; col <= c2; col++ ) {
+ TableMakeArrayIndex(row, col, buf1);
+ if (Tcl_FindHashEntry(tablePtr->selCells, buf1) == NULL) {
+ Tcl_CreateHashEntry(tablePtr->selCells, buf1, &dummy);
+ TableRefresh(tablePtr, row-tablePtr->rowOffset,
+ col-tablePtr->colOffset, CELL);
+ }
+ }
+ }
+ if (key) goto SET_BOTH;
+
+ /* Adjust the table for top left, selection on screen etc */
+ TableAdjustParams(tablePtr);
+
+ /* If the table was previously empty and we want to export the
+ * selection, we should grab it now */
+ if (entryPtr == NULL && tablePtr->exportSelection) {
+ Tk_OwnSelection(tablePtr->tkwin, XA_PRIMARY, TableLostSelection,
+ (ClientData) tablePtr);
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Table_ViewCmd --
+ * This procedure is invoked to process the x|yview method
+ * that corresponds to a table widget managed by this module.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+int
+Table_ViewCmd(ClientData clientData, register Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[])
+{
+ register Table *tablePtr = (Table *) clientData;
+ int row, col, value;
+ char *xy;
+
+ /* Check xview or yview */
+ if (objc > 5) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?args?");
+ return TCL_ERROR;
+ }
+ xy = Tcl_GetString(objv[1]);
+
+ if (objc == 2) {
+ Tcl_Obj *resultPtr;
+ int diff, x, y, w, h;
+ double first, last;
+
+ resultPtr = Tcl_GetObjResult(interp);
+ TableGetLastCell(tablePtr, &row, &col);
+ TableCellVCoords(tablePtr, row, col, &x, &y, &w, &h, 0);
+ if (*xy == 'y') {
+ if (row < tablePtr->titleRows) {
+ first = 0;
+ last = 1;
+ } else {
+ diff = tablePtr->rowStarts[tablePtr->titleRows];
+ last = (double) (tablePtr->rowStarts[tablePtr->rows]-diff);
+ first = (tablePtr->rowStarts[tablePtr->topRow]-diff) / last;
+ last = (h+tablePtr->rowStarts[row]-diff) / last;
+ }
+ } else {
+ if (col < tablePtr->titleCols) {
+ first = 0;
+ last = 1;
+ } else {
+ diff = tablePtr->colStarts[tablePtr->titleCols];
+ last = (double) (tablePtr->colStarts[tablePtr->cols]-diff);
+ first = (tablePtr->colStarts[tablePtr->leftCol]-diff) / last;
+ last = (w+tablePtr->colStarts[col]-diff) / last;
+ }
+ }
+ Tcl_ListObjAppendElement(NULL, resultPtr, Tcl_NewDoubleObj(first));
+ Tcl_ListObjAppendElement(NULL, resultPtr, Tcl_NewDoubleObj(last));
+ } else {
+ /* cache old topleft to see if it changes */
+ int oldTop = tablePtr->topRow, oldLeft = tablePtr->leftCol;
+
+ if (objc == 3) {
+ if (Tcl_GetIntFromObj(interp, objv[2], &value) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (*xy == 'y') {
+ tablePtr->topRow = value + tablePtr->titleRows;
+ } else {
+ tablePtr->leftCol = value + tablePtr->titleCols;
+ }
+ } else {
+ int result;
+ double frac;
+#if (TK_MINOR_VERSION > 0) /* 8.1+ */
+ result = Tk_GetScrollInfoObj(interp, objc, objv, &frac, &value);
+#else
+ int i;
+ char **argv = (char **) ckalloc((objc + 1) * sizeof(char *));
+ for (i = 0; i < objc; i++) {
+ argv[i] = Tcl_GetString(objv[i]);
+ }
+ argv[i] = NULL;
+ result = Tk_GetScrollInfo(interp, objc, argv, &frac, &value);
+ ckfree ((char *) argv);
+#endif
+ switch (result) {
+ case TK_SCROLL_ERROR:
+ return TCL_ERROR;
+ case TK_SCROLL_MOVETO:
+ if (frac < 0) frac = 0;
+ if (*xy == 'y') {
+ tablePtr->topRow = (int)(frac*tablePtr->rows)
+ +tablePtr->titleRows;
+ } else {
+ tablePtr->leftCol = (int)(frac*tablePtr->cols)
+ +tablePtr->titleCols;
+ }
+ break;
+ case TK_SCROLL_PAGES:
+ TableGetLastCell(tablePtr, &row, &col);
+ if (*xy == 'y') {
+ tablePtr->topRow += value * (row-tablePtr->topRow+1);
+ } else {
+ tablePtr->leftCol += value * (col-tablePtr->leftCol+1);
+ }
+ break;
+ case TK_SCROLL_UNITS:
+ if (*xy == 'y') {
+ tablePtr->topRow += value;
+ } else {
+ tablePtr->leftCol += value;
+ }
+ break;
+ }
+ }
+ /* maintain appropriate real index */
+ CONSTRAIN(tablePtr->topRow, tablePtr->titleRows, tablePtr->rows-1);
+ CONSTRAIN(tablePtr->leftCol, tablePtr->titleCols, tablePtr->cols-1);
+ /* Do the table adjustment if topRow || leftCol changed */
+ if (oldTop != tablePtr->topRow || oldLeft != tablePtr->leftCol) {
+ TableAdjustParams(tablePtr);
+ }
+ }
+
+ return TCL_OK;
+}
+
+#if 0
+/*
+ *--------------------------------------------------------------
+ *
+ * Table_Cmd --
+ * This procedure is invoked to process the CMD method
+ * that corresponds to a table widget managed by this module.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+int
+Table_Cmd(ClientData clientData, register Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[])
+{
+ register Table *tablePtr = (Table *) clientData;
+ int result = TCL_OK;
+
+ return result;
+}
+#endif
diff --git a/tktable/generic/tkTableEdit.c b/tktable/generic/tkTableEdit.c
new file mode 100644
index 0000000..b3ba6de
--- /dev/null
+++ b/tktable/generic/tkTableEdit.c
@@ -0,0 +1,723 @@
+/*
+ * tkTableEdit.c --
+ *
+ * This module implements editing functions of a table widget.
+ *
+ * Copyright (c) 1998-2000 Jeffrey Hobbs
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id: tkTableEdit.c,v 1.7 2002/10/16 07:30:56 hobbs Exp $
+ */
+
+#include "tkTable.h"
+
+static void TableModifyRC _ANSI_ARGS_((register Table *tablePtr,
+ int doRows, int movetag,
+ Tcl_HashTable *tagTblPtr, Tcl_HashTable *dimTblPtr,
+ int offset, int from, int to, int lo, int hi,
+ int outOfBounds));
+
+/* insert/delete subcommands */
+static CONST84 char *modCmdNames[] = {
+ "active", "cols", "rows", (char *)NULL
+};
+enum modCmd {
+ MOD_ACTIVE, MOD_COLS, MOD_ROWS
+};
+
+/* insert/delete row/col switches */
+static CONST84 char *rcCmdNames[] = {
+ "-keeptitles", "-holddimensions", "-holdselection",
+ "-holdtags", "-holdwindows", "--",
+ (char *) NULL
+};
+enum rcCmd {
+ OPT_TITLES, OPT_DIMS, OPT_SEL,
+ OPT_TAGS, OPT_WINS, OPT_LAST
+};
+
+#define HOLD_TITLES 1<<0
+#define HOLD_DIMS 1<<1
+#define HOLD_TAGS 1<<2
+#define HOLD_WINS 1<<3
+#define HOLD_SEL 1<<4
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Table_EditCmd --
+ * This procedure is invoked to process the insert/delete method
+ * that corresponds to a table widget managed by this module.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+int
+Table_EditCmd(ClientData clientData, register Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[])
+{
+ register Table *tablePtr = (Table *) clientData;
+ int doInsert, cmdIndex, first, last;
+
+ if (objc < 4) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "option ?switches? arg ?arg?");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[2], modCmdNames,
+ "option", 0, &cmdIndex) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ doInsert = (*(Tcl_GetString(objv[1])) == 'i');
+ switch ((enum modCmd) cmdIndex) {
+ case MOD_ACTIVE:
+ if (doInsert) {
+ /* INSERT */
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 3, objv, "index string");
+ return TCL_ERROR;
+ }
+ if (TableGetIcursorObj(tablePtr, objv[3], &first) != TCL_OK) {
+ return TCL_ERROR;
+ } else if ((tablePtr->flags & HAS_ACTIVE) &&
+ !(tablePtr->flags & ACTIVE_DISABLED) &&
+ tablePtr->state == STATE_NORMAL) {
+ TableInsertChars(tablePtr, first, Tcl_GetString(objv[4]));
+ }
+ } else {
+ /* DELETE */
+ if (objc > 5) {
+ Tcl_WrongNumArgs(interp, 3, objv, "first ?last?");
+ return TCL_ERROR;
+ }
+ if (TableGetIcursorObj(tablePtr, objv[3], &first) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (objc == 4) {
+ last = first+1;
+ } else if (TableGetIcursorObj(tablePtr, objv[4],
+ &last) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if ((last >= first) && (tablePtr->flags & HAS_ACTIVE) &&
+ !(tablePtr->flags & ACTIVE_DISABLED) &&
+ tablePtr->state == STATE_NORMAL) {
+ TableDeleteChars(tablePtr, first, last-first);
+ }
+ }
+ break; /* EDIT ACTIVE */
+
+ case MOD_COLS:
+ case MOD_ROWS: {
+ /*
+ * ROW/COL INSERTION/DELETION
+ * FIX: This doesn't handle spans
+ */
+ int i, lo, hi, argsLeft, offset, minkeyoff, doRows;
+ int maxrow, maxcol, maxkey, minkey, flags, count, *dimPtr;
+ Tcl_HashTable *tagTblPtr, *dimTblPtr;
+ Tcl_HashSearch search;
+
+ doRows = (cmdIndex == MOD_ROWS);
+ flags = 0;
+ for (i = 3; i < objc; i++) {
+ if (*(Tcl_GetString(objv[i])) != '-') {
+ break;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[i], rcCmdNames,
+ "switch", 0, &cmdIndex) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (cmdIndex == OPT_LAST) {
+ i++;
+ break;
+ }
+ switch (cmdIndex) {
+ case OPT_TITLES:
+ flags |= HOLD_TITLES;
+ break;
+ case OPT_DIMS:
+ flags |= HOLD_DIMS;
+ break;
+ case OPT_SEL:
+ flags |= HOLD_SEL;
+ break;
+ case OPT_TAGS:
+ flags |= HOLD_TAGS;
+ break;
+ case OPT_WINS:
+ flags |= HOLD_WINS;
+ break;
+ }
+ }
+ argsLeft = objc - i;
+ if (argsLeft < 1 || argsLeft > 2) {
+ Tcl_WrongNumArgs(interp, 3, objv, "?switches? index ?count?");
+ return TCL_ERROR;
+ }
+
+ count = 1;
+ maxcol = tablePtr->cols-1+tablePtr->colOffset;
+ maxrow = tablePtr->rows-1+tablePtr->rowOffset;
+ if (strcmp(Tcl_GetString(objv[i]), "end") == 0) {
+ /* allow "end" to be specified as an index */
+ first = (doRows) ? maxrow : maxcol;
+ } else if (Tcl_GetIntFromObj(interp, objv[i], &first) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (argsLeft == 2 &&
+ Tcl_GetIntFromObj(interp, objv[++i], &count) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (count == 0 || (tablePtr->state == STATE_DISABLED)) {
+ return TCL_OK;
+ }
+
+ if (doRows) {
+ maxkey = maxrow;
+ minkey = tablePtr->rowOffset;
+ minkeyoff = tablePtr->rowOffset+tablePtr->titleRows;
+ offset = tablePtr->rowOffset;
+ tagTblPtr = tablePtr->rowStyles;
+ dimTblPtr = tablePtr->rowHeights;
+ dimPtr = &(tablePtr->rows);
+ lo = tablePtr->colOffset
+ + ((flags & HOLD_TITLES) ? tablePtr->titleCols : 0);
+ hi = maxcol;
+ } else {
+ maxkey = maxcol;
+ minkey = tablePtr->colOffset;
+ minkeyoff = tablePtr->colOffset+tablePtr->titleCols;
+ offset = tablePtr->colOffset;
+ tagTblPtr = tablePtr->colStyles;
+ dimTblPtr = tablePtr->colWidths;
+ dimPtr = &(tablePtr->cols);
+ lo = tablePtr->rowOffset
+ + ((flags & HOLD_TITLES) ? tablePtr->titleRows : 0);
+ hi = maxrow;
+ }
+
+ /* constrain the starting index */
+ if (first > maxkey) {
+ first = maxkey;
+ } else if (first < minkey) {
+ first = minkey;
+ }
+ if (doInsert) {
+ /* +count means insert after index,
+ * -count means insert before index */
+ if (count < 0) {
+ count = -count;
+ } else {
+ first++;
+ }
+ if ((flags & HOLD_TITLES) && (first < minkeyoff)) {
+ count -= minkeyoff-first;
+ if (count <= 0) {
+ return TCL_OK;
+ }
+ first = minkeyoff;
+ }
+ if (!(flags & HOLD_DIMS)) {
+ maxkey += count;
+ *dimPtr += count;
+ }
+ /*
+ * We need to call TableAdjustParams before TableModifyRC to
+ * ensure that side effect code like var traces that might get
+ * called will access the correct new dimensions.
+ */
+ if (*dimPtr < 1) {
+ *dimPtr = 1;
+ }
+ TableAdjustParams(tablePtr);
+ for (i = maxkey; i >= first; i--) {
+ /* move row/col style && width/height here */
+ TableModifyRC(tablePtr, doRows, flags, tagTblPtr, dimTblPtr,
+ offset, i, i-count, lo, hi, ((i-count) < first));
+ }
+ if (!(flags & HOLD_WINS)) {
+ /*
+ * This may be a little severe, but it does unmap the
+ * windows that need to be unmapped, and those that should
+ * stay do remap correctly. [Bug #551325]
+ */
+ if (doRows) {
+ EmbWinUnmap(tablePtr,
+ first - tablePtr->rowOffset,
+ maxkey - tablePtr->rowOffset,
+ lo - tablePtr->colOffset,
+ hi - tablePtr->colOffset);
+ } else {
+ EmbWinUnmap(tablePtr,
+ lo - tablePtr->rowOffset,
+ hi - tablePtr->rowOffset,
+ first - tablePtr->colOffset,
+ maxkey - tablePtr->colOffset);
+ }
+ }
+ } else {
+ /* (index = i && count = 1) == (index = i && count = -1) */
+ if (count < 0) {
+ /* if the count is negative, make sure that the col count will
+ * delete no greater than the original index */
+ if (first+count < minkey) {
+ if (first-minkey < abs(count)) {
+ /*
+ * In this case, the user is asking to delete more rows
+ * than exist before the minkey, so we have to shrink
+ * the count down to the existing rows up to index.
+ */
+ count = first-minkey;
+ } else {
+ count += first-minkey;
+ }
+ first = minkey;
+ } else {
+ first += count;
+ count = -count;
+ }
+ }
+ if ((flags & HOLD_TITLES) && (first <= minkeyoff)) {
+ count -= minkeyoff-first;
+ if (count <= 0) {
+ return TCL_OK;
+ }
+ first = minkeyoff;
+ }
+ if (count > maxkey-first+1) {
+ count = maxkey-first+1;
+ }
+ if (!(flags & HOLD_DIMS)) {
+ *dimPtr -= count;
+ }
+ /*
+ * We need to call TableAdjustParams before TableModifyRC to
+ * ensure that side effect code like var traces that might get
+ * called will access the correct new dimensions.
+ */
+ if (*dimPtr < 1) {
+ *dimPtr = 1;
+ }
+ TableAdjustParams(tablePtr);
+ for (i = first; i <= maxkey; i++) {
+ TableModifyRC(tablePtr, doRows, flags, tagTblPtr, dimTblPtr,
+ offset, i, i+count, lo, hi, ((i+count) > maxkey));
+ }
+ }
+ if (!(flags & HOLD_SEL) &&
+ Tcl_FirstHashEntry(tablePtr->selCells, &search) != NULL) {
+ /* clear selection - forceful, but effective */
+ Tcl_DeleteHashTable(tablePtr->selCells);
+ Tcl_InitHashTable(tablePtr->selCells, TCL_STRING_KEYS);
+ }
+
+ /*
+ * Make sure that the modified dimension is actually legal
+ * after removing all that stuff.
+ */
+ if (*dimPtr < 1) {
+ *dimPtr = 1;
+ TableAdjustParams(tablePtr);
+ }
+
+ /* change the geometry */
+ TableGeometryRequest(tablePtr);
+ /* FIX:
+ * This has to handle when the previous rows/cols resize because
+ * of the *stretchmode. InvalidateAll does that, but could be
+ * more efficient.
+ */
+ TableInvalidateAll(tablePtr, 0);
+ break;
+ }
+
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableDeleteChars --
+ * Remove one or more characters from an table widget.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory gets freed, the table gets modified and (eventually)
+ * redisplayed.
+ *
+ *----------------------------------------------------------------------
+ */
+void
+TableDeleteChars(tablePtr, index, count)
+ register Table *tablePtr; /* Table widget to modify. */
+ int index; /* Index of first character to delete. */
+ int count; /* How many characters to delete. */
+{
+#ifdef TCL_UTF_MAX
+ int byteIndex, byteCount, newByteCount, numBytes, numChars;
+ char *new, *string;
+
+ string = tablePtr->activeBuf;
+ numBytes = strlen(string);
+ numChars = Tcl_NumUtfChars(string, numBytes);
+ if ((index + count) > numChars) {
+ count = numChars - index;
+ }
+ if (count <= 0) {
+ return;
+ }
+
+ byteIndex = Tcl_UtfAtIndex(string, index) - string;
+ byteCount = Tcl_UtfAtIndex(string + byteIndex, count)
+ - (string + byteIndex);
+
+ newByteCount = numBytes + 1 - byteCount;
+ new = (char *) ckalloc((unsigned) newByteCount);
+ memcpy(new, string, (size_t) byteIndex);
+ strcpy(new + byteIndex, string + byteIndex + byteCount);
+#else
+ int oldlen;
+ char *new;
+
+ /* this gets the length of the string, as well as ensuring that
+ * the cursor isn't beyond the end char */
+ TableGetIcursor(tablePtr, "end", &oldlen);
+
+ if ((index+count) > oldlen)
+ count = oldlen-index;
+ if (count <= 0)
+ return;
+
+ new = (char *) ckalloc((unsigned)(oldlen-count+1));
+ strncpy(new, tablePtr->activeBuf, (size_t) index);
+ strcpy(new+index, tablePtr->activeBuf+index+count);
+ /* make sure this string is null terminated */
+ new[oldlen-count] = '\0';
+#endif
+ /* This prevents deletes on BREAK or validation error. */
+ if (tablePtr->validate &&
+ TableValidateChange(tablePtr, tablePtr->activeRow+tablePtr->rowOffset,
+ tablePtr->activeCol+tablePtr->colOffset,
+ tablePtr->activeBuf, new, index) != TCL_OK) {
+ ckfree(new);
+ return;
+ }
+
+ ckfree(tablePtr->activeBuf);
+ tablePtr->activeBuf = new;
+
+ /* mark the text as changed */
+ tablePtr->flags |= TEXT_CHANGED;
+
+ if (tablePtr->icursor >= index) {
+ if (tablePtr->icursor >= (index+count)) {
+ tablePtr->icursor -= count;
+ } else {
+ tablePtr->icursor = index;
+ }
+ }
+
+ TableSetActiveIndex(tablePtr);
+
+ TableRefresh(tablePtr, tablePtr->activeRow, tablePtr->activeCol, CELL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableInsertChars --
+ * Add new characters to the active cell of a table widget.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * New information gets added to tablePtr; it will be redisplayed
+ * soon, but not necessarily immediately.
+ *
+ *----------------------------------------------------------------------
+ */
+void
+TableInsertChars(tablePtr, index, value)
+ register Table *tablePtr; /* Table that is to get the new elements. */
+ int index; /* Add the new elements before this element. */
+ char *value; /* New characters to add (NULL-terminated
+ * string). */
+{
+#ifdef TCL_UTF_MAX
+ int oldlen, byteIndex, byteCount;
+ char *new, *string;
+
+ byteCount = strlen(value);
+ if (byteCount == 0) {
+ return;
+ }
+
+ /* Is this an autoclear and this is the first update */
+ /* Note that this clears without validating */
+ if (tablePtr->autoClear && !(tablePtr->flags & TEXT_CHANGED)) {
+ /* set the buffer to be empty */
+ tablePtr->activeBuf = (char *)ckrealloc(tablePtr->activeBuf, 1);
+ tablePtr->activeBuf[0] = '\0';
+ /* the insert position now has to be 0 */
+ index = 0;
+ tablePtr->icursor = 0;
+ }
+
+ string = tablePtr->activeBuf;
+ byteIndex = Tcl_UtfAtIndex(string, index) - string;
+
+ oldlen = strlen(string);
+ new = (char *) ckalloc((unsigned)(oldlen + byteCount + 1));
+ memcpy(new, string, (size_t) byteIndex);
+ strcpy(new + byteIndex, value);
+ strcpy(new + byteIndex + byteCount, string + byteIndex);
+
+ /* validate potential new active buffer */
+ /* This prevents inserts on either BREAK or validation error. */
+ if (tablePtr->validate &&
+ TableValidateChange(tablePtr, tablePtr->activeRow+tablePtr->rowOffset,
+ tablePtr->activeCol+tablePtr->colOffset,
+ tablePtr->activeBuf, new, byteIndex) != TCL_OK) {
+ ckfree(new);
+ return;
+ }
+
+ /*
+ * The following construction is used because inserting improperly
+ * formed UTF-8 sequences between other improperly formed UTF-8
+ * sequences could result in actually forming valid UTF-8 sequences;
+ * the number of characters added may not be Tcl_NumUtfChars(string, -1),
+ * because of context. The actual number of characters added is how
+ * many characters were are in the string now minus the number that
+ * used to be there.
+ */
+
+ if (tablePtr->icursor >= index) {
+ tablePtr->icursor += Tcl_NumUtfChars(new, oldlen+byteCount)
+ - Tcl_NumUtfChars(tablePtr->activeBuf, oldlen);
+ }
+
+ ckfree(string);
+ tablePtr->activeBuf = new;
+
+#else
+ int oldlen, newlen;
+ char *new;
+
+ newlen = strlen(value);
+ if (newlen == 0) return;
+
+ /* Is this an autoclear and this is the first update */
+ /* Note that this clears without validating */
+ if (tablePtr->autoClear && !(tablePtr->flags & TEXT_CHANGED)) {
+ /* set the buffer to be empty */
+ tablePtr->activeBuf = (char *)ckrealloc(tablePtr->activeBuf, 1);
+ tablePtr->activeBuf[0] = '\0';
+ /* the insert position now has to be 0 */
+ index = 0;
+ }
+ oldlen = strlen(tablePtr->activeBuf);
+ /* get the buffer to at least the right length */
+ new = (char *) ckalloc((unsigned)(oldlen+newlen+1));
+ strncpy(new, tablePtr->activeBuf, (size_t) index);
+ strcpy(new+index, value);
+ strcpy(new+index+newlen, (tablePtr->activeBuf)+index);
+ /* make sure this string is null terminated */
+ new[oldlen+newlen] = '\0';
+
+ /* validate potential new active buffer */
+ /* This prevents inserts on either BREAK or validation error. */
+ if (tablePtr->validate &&
+ TableValidateChange(tablePtr, tablePtr->activeRow+tablePtr->rowOffset,
+ tablePtr->activeCol+tablePtr->colOffset,
+ tablePtr->activeBuf, new, index) != TCL_OK) {
+ ckfree(new);
+ return;
+ }
+ ckfree(tablePtr->activeBuf);
+ tablePtr->activeBuf = new;
+
+ if (tablePtr->icursor >= index) {
+ tablePtr->icursor += newlen;
+ }
+#endif
+
+ /* mark the text as changed */
+ tablePtr->flags |= TEXT_CHANGED;
+
+ TableSetActiveIndex(tablePtr);
+
+ TableRefresh(tablePtr, tablePtr->activeRow, tablePtr->activeCol, CELL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableModifyRC --
+ * Helper function that does the core work of moving rows/cols
+ * and associated tags.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Moves cell data and possibly tag data
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+TableModifyRC(tablePtr, doRows, flags, tagTblPtr, dimTblPtr,
+ offset, from, to, lo, hi, outOfBounds)
+ Table *tablePtr; /* Information about text widget. */
+ int doRows; /* rows (1) or cols (0) */
+ int flags; /* flags indicating what to move */
+ Tcl_HashTable *tagTblPtr, *dimTblPtr; /* Pointers to the row/col tags
+ * and width/height tags */
+ int offset; /* appropriate offset */
+ int from, to; /* the from and to row/col */
+ int lo, hi; /* the lo and hi col/row */
+ int outOfBounds; /* the boundary check for shifting items */
+{
+ int j, new;
+ char buf[INDEX_BUFSIZE], buf1[INDEX_BUFSIZE];
+ Tcl_HashEntry *entryPtr, *newPtr;
+ TableEmbWindow *ewPtr;
+
+ /*
+ * move row/col style && width/height here
+ * If -holdtags is specified, we don't move the user-set widths/heights
+ * of the absolute rows/columns, otherwise we enter here to move the
+ * dimensions appropriately
+ */
+ if (!(flags & HOLD_TAGS)) {
+ entryPtr = Tcl_FindHashEntry(tagTblPtr, (char *)from);
+ if (entryPtr != NULL) {
+ Tcl_DeleteHashEntry(entryPtr);
+ }
+ entryPtr = Tcl_FindHashEntry(dimTblPtr, (char *)from-offset);
+ if (entryPtr != NULL) {
+ Tcl_DeleteHashEntry(entryPtr);
+ }
+ if (!outOfBounds) {
+ entryPtr = Tcl_FindHashEntry(tagTblPtr, (char *)to);
+ if (entryPtr != NULL) {
+ newPtr = Tcl_CreateHashEntry(tagTblPtr, (char *)from, &new);
+ Tcl_SetHashValue(newPtr, Tcl_GetHashValue(entryPtr));
+ Tcl_DeleteHashEntry(entryPtr);
+ }
+ entryPtr = Tcl_FindHashEntry(dimTblPtr, (char *)to-offset);
+ if (entryPtr != NULL) {
+ newPtr = Tcl_CreateHashEntry(dimTblPtr, (char *)from-offset,
+ &new);
+ Tcl_SetHashValue(newPtr, Tcl_GetHashValue(entryPtr));
+ Tcl_DeleteHashEntry(entryPtr);
+ }
+ }
+ }
+ for (j = lo; j <= hi; j++) {
+ if (doRows /* rows */) {
+ TableMakeArrayIndex(from, j, buf);
+ TableMakeArrayIndex(to, j, buf1);
+ TableMoveCellValue(tablePtr, to, j, buf1, from, j, buf,
+ outOfBounds);
+ } else {
+ TableMakeArrayIndex(j, from, buf);
+ TableMakeArrayIndex(j, to, buf1);
+ TableMoveCellValue(tablePtr, j, to, buf1, j, from, buf,
+ outOfBounds);
+ }
+ /*
+ * If -holdselection is specified, we leave the selected cells in the
+ * absolute cell values, otherwise we enter here to move the
+ * selection appropriately
+ */
+ if (!(flags & HOLD_SEL)) {
+ entryPtr = Tcl_FindHashEntry(tablePtr->selCells, buf);
+ if (entryPtr != NULL) {
+ Tcl_DeleteHashEntry(entryPtr);
+ }
+ if (!outOfBounds) {
+ entryPtr = Tcl_FindHashEntry(tablePtr->selCells, buf1);
+ if (entryPtr != NULL) {
+ Tcl_CreateHashEntry(tablePtr->selCells, buf, &new);
+ Tcl_DeleteHashEntry(entryPtr);
+ }
+ }
+ }
+ /*
+ * If -holdtags is specified, we leave the tags in the
+ * absolute cell values, otherwise we enter here to move the
+ * tags appropriately
+ */
+ if (!(flags & HOLD_TAGS)) {
+ entryPtr = Tcl_FindHashEntry(tablePtr->cellStyles, buf);
+ if (entryPtr != NULL) {
+ Tcl_DeleteHashEntry(entryPtr);
+ }
+ if (!outOfBounds) {
+ entryPtr = Tcl_FindHashEntry(tablePtr->cellStyles, buf1);
+ if (entryPtr != NULL) {
+ newPtr = Tcl_CreateHashEntry(tablePtr->cellStyles, buf,
+ &new);
+ Tcl_SetHashValue(newPtr, Tcl_GetHashValue(entryPtr));
+ Tcl_DeleteHashEntry(entryPtr);
+ }
+ }
+ }
+ /*
+ * If -holdwindows is specified, we leave the windows in the
+ * absolute cell values, otherwise we enter here to move the
+ * windows appropriately
+ */
+ if (!(flags & HOLD_WINS)) {
+ /*
+ * Delete whatever window might be in our destination
+ */
+ Table_WinDelete(tablePtr, buf);
+ if (!outOfBounds) {
+ /*
+ * buf1 is where the window is
+ * buf is where we want it to be
+ *
+ * This is an adaptation of Table_WinMove, which we can't
+ * use because we are intermediately fiddling with boundaries
+ */
+ entryPtr = Tcl_FindHashEntry(tablePtr->winTable, buf1);
+ if (entryPtr != NULL) {
+ /*
+ * If there was a window in our source,
+ * get the window pointer to move it
+ */
+ ewPtr = (TableEmbWindow *) Tcl_GetHashValue(entryPtr);
+ /* and free the old hash table entry */
+ Tcl_DeleteHashEntry(entryPtr);
+
+ entryPtr = Tcl_CreateHashEntry(tablePtr->winTable, buf,
+ &new);
+ /*
+ * We needn't check if a window was in buf, since the
+ * Table_WinDelete above should guarantee that no window
+ * is there. Just set the new entry's value.
+ */
+ Tcl_SetHashValue(entryPtr, (ClientData) ewPtr);
+ ewPtr->hPtr = entryPtr;
+ }
+ }
+ }
+ }
+}
diff --git a/tktable/generic/tkTableInitScript.h b/tktable/generic/tkTableInitScript.h
new file mode 100644
index 0000000..a61d19b
--- /dev/null
+++ b/tktable/generic/tkTableInitScript.h
@@ -0,0 +1,90 @@
+/*
+ * tkTableInitScript.h --
+ *
+ * This file contains common init script for tkTable
+ *
+ * Copyright (c) 1998 Jeffrey Hobbs
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+/*
+ * The following string is the startup script executed when the table is
+ * loaded. It looks on disk in several different directories for a script
+ * "TBL_RUNTIME" (as defined in Makefile) that is compatible with this
+ * version of tkTable. The sourced script has all key bindings defined.
+ */
+
+static char tkTableInitScript[] = "if {[info proc tkTableInit]==\"\"} {\n\
+ proc tkTableInit {} {\n\
+ global tk_library tcl_pkgPath errorInfo env\n\
+ rename tkTableInit {}\n\
+ set errors {}\n\
+ if {![info exists env(TK_TABLE_LIBRARY_FILE)]} {\n\
+ set env(TK_TABLE_LIBRARY_FILE) " TBL_RUNTIME "\n\
+ }\n\
+ if {[info exists env(TK_TABLE_LIBRARY)]} {\n\
+ lappend dirs $env(TK_TABLE_LIBRARY)\n\
+ }\n\
+ lappend dirs " TBL_RUNTIME_DIR "\n\
+ if {[info exists tcl_pkgPath]} {\n\
+ foreach i $tcl_pkgPath {\n\
+ lappend dirs [file join $i Tktable" PACKAGE_VERSION "] \\\n\
+ [file join $i Tktable] $i\n\
+ }\n\
+ }\n\
+ lappend dirs $tk_library [pwd]\n\
+ foreach i $dirs {\n\
+ set try [file join $i $env(TK_TABLE_LIBRARY_FILE)]\n\
+ if {[file exists $try]} {\n\
+ if {![catch {uplevel #0 [list source $try]} msg]} {\n\
+ set env(TK_TABLE_LIBRARY) $i\n\
+ return\n\
+ } else {\n\
+ append errors \"$try: $msg\n$errorInfo\n\"\n\
+ }\n\
+ }\n\
+ }\n"
+#ifdef NO_EMBEDDED_RUNTIME
+" set msg \"Can't find a $env(TK_TABLE_LIBRARY_FILE) in the following directories: \n\"\n\
+ append msg \" $dirs\n\n$errors\n\n\"\n\
+ append msg \"This probably means that TkTable wasn't installed properly.\"\n\
+ return -code error $msg\n"
+#else
+" set env(TK_TABLE_LIBRARY) EMBEDDED_RUNTIME\n"
+# ifdef MAC_TCL
+" source -rsrc tkTable"
+# else
+" uplevel #0 {"
+# include "tkTable.tcl.h"
+" }"
+# endif
+#endif
+" }\n\
+}\n\
+tkTableInit";
+
+/*
+ * The init script can't make certain calls in a safe interpreter,
+ * so we always have to use the embedded runtime for it
+ */
+static char tkTableSafeInitScript[] = "if {[info proc tkTableInit]==\"\"} {\n\
+ proc tkTableInit {} {\n\
+ set env(TK_TABLE_LIBRARY) EMBEDDED_RUNTIME\n"
+#ifdef NO_EMBEDDED_RUNTIME
+" append msg \"tkTable requires embedded runtime to be compiled for\"\n\
+ append msg \" use in safe interpreters\"\n\
+ return -code error $msg\n"
+#endif
+# ifdef MAC_TCL
+" source -rsrc tkTable"
+# else
+" uplevel #0 {"
+# include "tkTable.tcl.h"
+" }"
+# endif
+" }\n\
+}\n\
+tkTableInit";
+
diff --git a/tktable/generic/tkTablePs.c b/tktable/generic/tkTablePs.c
new file mode 100644
index 0000000..018f079
--- /dev/null
+++ b/tktable/generic/tkTablePs.c
@@ -0,0 +1,1299 @@
+/*
+ * tkTablePs.c --
+ *
+ * This module implements postscript output for table widgets.
+ * Based off of Tk8.1a2 tkCanvPs.c.
+ *
+ * Copyright (c) 1991-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * changes 1998 Copyright (c) 1998 Jeffrey Hobbs
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#include "tkTable.h"
+
+/* This is for Tcl_DStringAppendAll */
+#if defined(__STDC__) || defined(HAS_STDARG)
+#include
+#else
+#include
+#endif
+
+#ifndef TCL_INTEGER_SPACE
+/* This appears in 8.1 */
+#define TCL_INTEGER_SPACE 24
+#endif
+
+/*
+ * One of the following structures is created to keep track of Postscript
+ * output being generated. It consists mostly of information provided on
+ * the widget command line.
+ */
+
+typedef struct TkPostscriptInfo {
+ int x, y, width, height; /* Area to print, in table pixel
+ * coordinates. */
+ int x2, y2; /* x+width and y+height. */
+ char *pageXString; /* String value of "-pagex" option or NULL. */
+ char *pageYString; /* String value of "-pagey" option or NULL. */
+ double pageX, pageY; /* Postscript coordinates (in points)
+ * corresponding to pageXString and
+ * pageYString. Don't forget that y-values
+ * grow upwards for Postscript! */
+ char *pageWidthString; /* Printed width of output. */
+ char *pageHeightString; /* Printed height of output. */
+ double scale; /* Scale factor for conversion: each pixel
+ * maps into this many points. */
+ Tk_Anchor pageAnchor; /* How to anchor bbox on Postscript page. */
+ int rotate; /* Non-zero means output should be rotated
+ * on page (landscape mode). */
+ char *fontVar; /* If non-NULL, gives name of global variable
+ * containing font mapping information.
+ * Malloc'ed. */
+ char *colorVar; /* If non-NULL, give name of global variable
+ * containing color mapping information.
+ * Malloc'ed. */
+ char *colorMode; /* Mode for handling colors: "monochrome",
+ * "gray", or "color". Malloc'ed. */
+ int colorLevel; /* Numeric value corresponding to colorMode:
+ * 0 for mono, 1 for gray, 2 for color. */
+ char *fileName; /* Name of file in which to write Postscript;
+ * NULL means return Postscript info as
+ * result. Malloc'ed. */
+ char *channelName; /* If -channel is specified, the name of
+ * the channel to use. */
+ Tcl_Channel chan; /* Open channel corresponding to fileName. */
+ Tcl_HashTable fontTable; /* Hash table containing names of all font
+ * families used in output. The hash table
+ * values are not used. */
+ char *first, *last; /* table indices to start and end at */
+} TkPostscriptInfo;
+
+/*
+ * The table below provides a template that's used to process arguments
+ * to the table "postscript" command and fill in TkPostscriptInfo
+ * structures.
+ */
+
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_STRING, "-colormap", (char *) NULL, (char *) NULL, "",
+ Tk_Offset(TkPostscriptInfo, colorVar), 0},
+ {TK_CONFIG_STRING, "-colormode", (char *) NULL, (char *) NULL, "",
+ Tk_Offset(TkPostscriptInfo, colorMode), 0},
+ {TK_CONFIG_STRING, "-file", (char *) NULL, (char *) NULL, "",
+ Tk_Offset(TkPostscriptInfo, fileName), 0},
+ {TK_CONFIG_STRING, "-channel", (char *) NULL, (char *) NULL, "",
+ Tk_Offset(TkPostscriptInfo, channelName), 0},
+ {TK_CONFIG_STRING, "-first", (char *) NULL, (char *) NULL, "",
+ Tk_Offset(TkPostscriptInfo, first), 0},
+ {TK_CONFIG_STRING, "-fontmap", (char *) NULL, (char *) NULL, "",
+ Tk_Offset(TkPostscriptInfo, fontVar), 0},
+ {TK_CONFIG_PIXELS, "-height", (char *) NULL, (char *) NULL, "",
+ Tk_Offset(TkPostscriptInfo, height), 0},
+ {TK_CONFIG_STRING, "-last", (char *) NULL, (char *) NULL, "",
+ Tk_Offset(TkPostscriptInfo, last), 0},
+ {TK_CONFIG_ANCHOR, "-pageanchor", (char *) NULL, (char *) NULL, "",
+ Tk_Offset(TkPostscriptInfo, pageAnchor), 0},
+ {TK_CONFIG_STRING, "-pageheight", (char *) NULL, (char *) NULL, "",
+ Tk_Offset(TkPostscriptInfo, pageHeightString), 0},
+ {TK_CONFIG_STRING, "-pagewidth", (char *) NULL, (char *) NULL, "",
+ Tk_Offset(TkPostscriptInfo, pageWidthString), 0},
+ {TK_CONFIG_STRING, "-pagex", (char *) NULL, (char *) NULL, "",
+ Tk_Offset(TkPostscriptInfo, pageXString), 0},
+ {TK_CONFIG_STRING, "-pagey", (char *) NULL, (char *) NULL, "",
+ Tk_Offset(TkPostscriptInfo, pageYString), 0},
+ {TK_CONFIG_BOOLEAN, "-rotate", (char *) NULL, (char *) NULL, "",
+ Tk_Offset(TkPostscriptInfo, rotate), 0},
+ {TK_CONFIG_PIXELS, "-width", (char *) NULL, (char *) NULL, "",
+ Tk_Offset(TkPostscriptInfo, width), 0},
+ {TK_CONFIG_PIXELS, "-x", (char *) NULL, (char *) NULL, "",
+ Tk_Offset(TkPostscriptInfo, x), 0},
+ {TK_CONFIG_PIXELS, "-y", (char *) NULL, (char *) NULL, "",
+ Tk_Offset(TkPostscriptInfo, y), 0},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ * The prolog data. Generated by str2c from prolog.ps
+ * This was split in small chunks by str2c because
+ * some C compiler have limitations on the size of static strings.
+ * (str2c is a small tcl script in tcl's tool directory (source release))
+ */
+/*
+ * This is a stripped down version of that found in tkCanvPs.c of Tk8.1a2.
+ * Comments, and stuff pertaining to stipples and other unused entities
+ * have been removed
+ */
+static CONST char * CONST prolog[]= {
+ /* Start of part 1 */
+ "%%BeginProlog\n\
+50 dict begin\n\
+\n\
+% This is standard prolog for Postscript generated by Tk's table widget.\n\
+% Based of standard prolog for Tk's canvas widget.\n\
+\n\
+% INITIALIZING VARIABLES\n\
+\n\
+/baseline 0 def\n\
+/height 0 def\n\
+/justify 0 def\n\
+/cellHeight 0 def\n\
+/cellWidth 0 def\n\
+/spacing 0 def\n\
+/strings 0 def\n\
+/xoffset 0 def\n\
+/yoffset 0 def\n\
+/x 0 def\n\
+/y 0 def\n\
+\n\
+% Define the array ISOLatin1Encoding, if it isn't already present.\n\
+\n\
+systemdict /ISOLatin1Encoding known not {\n\
+ /ISOLatin1Encoding [\n\
+ /space /space /space /space /space /space /space /space\n\
+ /space /space /space /space /space /space /space /space\n\
+ /space /space /space /space /space /space /space /space\n\
+ /space /space /space /space /space /space /space /space\n\
+ /space /exclam /quotedbl /numbersign /dollar /percent /ampersand\n\
+ /quoteright\n\
+ /parenleft /parenright /asterisk /plus /comma /minus /period /slash\n\
+ /zero /one /two /three /four /five /six /seven\n\
+ /eight /nine /colon /semicolon /less /equal /greater /question\n\
+ /at /A /B /C /D /E /F /G\n\
+ /H /I /J /K /L /M /N /O\n\
+ /P /Q /R /S /T /U /V /W\n\
+ /X /Y /Z /bracketleft /backslash /bracketright /asciicircum /underscore\n\
+ /quoteleft /a /b /c /d /e /f /g\n\
+ /h /i /j /k /l /m /n /o\n\
+ /p /q /r /s /t /u /v /w\n\
+ /x /y /z /braceleft /bar /braceright /asciitilde /space\n\
+ /space /space /space /space /space /space /space /space\n\
+ /space /space /space /space /space /space /space /space\n\
+ /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent\n\
+ /dieresis /space /ring /cedilla /space /hungarumlaut /ogonek /caron\n\
+ /space /exclamdown /cent /sterling /currency /yen /brokenbar /section\n\
+ /dieresis /copyright /ordfem",
+
+ "inine /guillemotleft /logicalnot /hyphen\n\
+ /registered /macron\n\
+ /degree /plusminus /twosuperior /threesuperior /acute /mu /paragraph\n\
+ /periodcentered\n\
+ /cedillar /onesuperior /ordmasculine /guillemotright /onequarter\n\
+ /onehalf /threequarters /questiondown\n\
+ /Agrave /Aacute /Acircumflex /Atilde /Adieresis /Aring /AE /Ccedilla\n\
+ /Egrave /Eacute /Ecircumflex /Edieresis /Igrave /Iacute /Icircumflex\n\
+ /Idieresis\n\
+ /Eth /Ntilde /Ograve /Oacute /Ocircumflex /Otilde /Odieresis /multiply\n\
+ /Oslash /Ugrave /Uacute /Ucircumflex /Udieresis /Yacute /Thorn\n\
+ /germandbls\n\
+ /agrave /aacute /acircumflex /atilde /adieresis /aring /ae /ccedilla\n\
+ /egrave /eacute /ecircumflex /edieresis /igrave /iacute /icircumflex\n\
+ /idieresis\n\
+ /eth /ntilde /ograve /oacute /ocircumflex /otilde /odieresis /divide\n\
+ /oslash /ugrave /uacute /ucircumflex /udieresis /yacute /thorn\n\
+ /ydieresis\n\
+ ] def\n\
+} if\n",
+
+ "\n\
+% font ISOEncode font\n\
+% This procedure changes the encoding of a font from the default\n\
+% Postscript encoding to ISOLatin1. It's typically invoked just\n\
+% before invoking \"setfont\". The body of this procedure comes from\n\
+% Section 5.6.1 of the Postscript book.\n\
+\n\
+/ISOEncode {\n\
+ dup length dict begin\n\
+ {1 index /FID ne {def} {pop pop} ifelse} forall\n\
+ /Encoding ISOLatin1Encoding def\n\
+ currentdict\n\
+ end\n\
+\n\
+ % I'm not sure why it's necessary to use \"definefont\" on this new\n\
+ % font, but it seems to be important; just use the name \"Temporary\"\n\
+ % for the font.\n\
+\n\
+ /Temporary exch definefont\n\
+} bind def\n\
+\n\
+% -- AdjustColor --\n\
+% Given a color value already set for output by the caller, adjusts\n\
+% that value to a grayscale or mono value if requested by the CL variable.\n\
+\n\
+/AdjustColor {\n\
+ setrgbcolor\n\
+ CL 2 lt {\n\
+ currentgray\n\
+ CL 0 eq {\n\
+ .5 lt {0} {1} ifelse\n\
+ } if\n\
+ setgray\n\
+ } if\n\
+} bind def\n\
+\n\
+% pointSize fontName SetFont\n\
+% The ISOEncode shouldn't be done to Symbol fonts...\n\
+/SetFont {\n\
+ findfont exch scalefont ISOEncode setfont\n\
+} def\n\
+\n",
+
+ "% x y strings spacing xoffset yoffset justify ... DrawText --\n\
+% This procedure does all of the real work of drawing text. The\n\
+% color and font must already have been set by the caller, and the\n\
+% following arguments must be on the stack:\n\
+%\n\
+% x, y - Coordinates at which to draw text.\n\
+% strings - An array of strings, one for each line of the text item,\n\
+% in order from top to bottom.\n\
+% spacing - Spacing between lines.\n\
+% xoffset - Horizontal offset for text bbox relative to x and y: 0 for\n\
+% nw/w/sw anchor, -0.5 for n/center/s, and -1.0 for ne/e/se.\n\
+% yoffset - Vertical offset for text bbox relative to x and y: 0 for\n\
+% nw/n/ne anchor, +0.5 for w/center/e, and +1.0 for sw/s/se.\n\
+% justify - 0 for left justification, 0.5 for center, 1 for right justify.\n\
+% cellWidth - width for this cell\n\
+% cellHeight - height for this cell\n\
+%\n\
+% Also, when this procedure is invoked, the color and font must already\n\
+% have been set for the text.\n\
+\n",
+
+ "/DrawCellText {\n\
+ /cellHeight exch def\n\
+ /cellWidth exch def\n\
+ /justify exch def\n\
+ /yoffset exch def\n\
+ /xoffset exch def\n\
+ /spacing exch def\n\
+ /strings exch def\n\
+ /y exch def\n\
+ /x exch def\n\
+\n\
+ % Compute the baseline offset and the actual font height.\n\
+\n\
+ 0 0 moveto (TXygqPZ) false charpath\n\
+ pathbbox dup /baseline exch def\n\
+ exch pop exch sub /height exch def pop\n\
+ newpath\n\
+\n\
+ % Translate coordinates first so that the origin is at the upper-left\n\
+ % corner of the text's bounding box. Remember that x and y for\n\
+ % positioning are still on the stack.\n\
+\n\
+ col0 x sub row0 y sub translate\n\
+ cellWidth xoffset mul\n\
+ strings length 1 sub spacing mul height add yoffset mul translate\n\
+\n\
+ % Now use the baseline and justification information to translate so\n\
+ % that the origin is at the baseline and positioning point for the\n\
+ % first line of text.\n\
+\n\
+ justify cellWidth mul baseline neg translate\n\
+\n\
+ % Iterate over each of the lines to output it. For each line,\n\
+ % compute its width again so it can be properly justified, then\n\
+ % display it.\n\
+\n\
+ strings {\n\
+ dup stringwidth pop\n\
+ justify neg mul 0 moveto\n\
+ show\n\
+ 0 spacing neg translate\n\
+ } forall\n\
+} bind def\n\
+\n",
+
+ "%\n\
+% x, y - Coordinates at which to draw text.\n\
+% strings - An array of strings, one for each line of the text item,\n\
+% in order from top to bottom.\n\
+% spacing - Spacing between lines.\n\
+% xoffset - Horizontal offset for text bbox relative to x and y: 0 for\n\
+% nw/w/sw anchor, -0.5 for n/center/s, and -1.0 for ne/e/se.\n\
+% yoffset - Vertical offset for text bbox relative to x and y: 0 for\n\
+% nw/n/ne anchor, +0.5 for w/center/e, and +1.0 for sw/s/se.\n\
+% justify - 0 for left justification, 0.5 for center, 1 for right justify.\n\
+% cellWidth - width for this cell\n\
+% cellHeight - height for this cell\n\
+%\n\
+% Also, when this procedure is invoked, the color and font must already\n\
+% have been set for the text.\n\
+\n\
+/DrawCellTextOld {\n\
+ /cellHeight exch def\n\
+ /cellWidth exch def\n\
+ /justify exch def\n\
+ /yoffset exch def\n\
+ /xoffset exch def\n\
+ /spacing exch def\n\
+ /strings exch def\n\
+\n\
+ % Compute the baseline offset and the actual font height.\n\
+\n\
+ 0 0 moveto (TXygqPZ) false charpath\n\
+ pathbbox dup /baseline exch def\n\
+ exch pop exch sub /height exch def pop\n\
+ newpath\n\
+\n\
+ % Translate coordinates first so that the origin is at the upper-left\n\
+ % corner of the text's bounding box. Remember that x and y for\n\
+ % positioning are still on the stack.\n\
+\n\
+ translate\n\
+ cellWidth xoffset mul\n\
+ strings length 1 sub spacing mul height add yoffset mul translate\n\
+\n\
+ % Now use the baseline and justification information to translate so\n\
+ % that the origin is at the baseline and positioning point for the\n\
+ % first line of text.\n\
+\n\
+ justify cellWidth mul baseline neg translate\n\
+\n\
+ % Iterate over each of the lines to output it. For each line,\n\
+ % compute its width again so it can be properly justified, then\n\
+ % display it.\n\
+\n\
+ strings {\n\
+ dup stringwidth pop\n\
+ justify neg mul 0 moveto\n\
+ show\n\
+ 0 spacing neg translate\n\
+ } forall\n\
+} bind def\n\
+\n\
+%%EndProlog\n\
+",
+ /* End of part 5 */
+
+ NULL /* End of data marker */
+};
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static int GetPostscriptPoints _ANSI_ARGS_((Tcl_Interp *interp,
+ char *string, double *doublePtr));
+int Tk_TablePsFont _ANSI_ARGS_((Tcl_Interp *interp,
+ Table *tablePtr, Tk_Font tkfont));
+int Tk_TablePsColor _ANSI_ARGS_((Tcl_Interp *interp,
+ Table *tablePtr, XColor *colorPtr));
+static int TextToPostscript _ANSI_ARGS_((Tcl_Interp *interp,
+ Table *tablePtr, TableTag *tagPtr, int tagX, int tagY,
+ int width, int height, int row, int col,
+ Tk_TextLayout textLayout));
+
+/*
+ * Tcl could really use some more convenience routines...
+ * This is just Tcl_DStringAppend for multiple lines, including
+ * the full text of each line
+ */
+void
+Tcl_DStringAppendAll TCL_VARARGS_DEF(Tcl_DString *, arg1)
+{
+ va_list argList;
+ Tcl_DString *dstringPtr;
+ char *string;
+
+ dstringPtr = TCL_VARARGS_START(Tcl_DString *, arg1, argList);
+ while ((string = va_arg(argList, char *)) != NULL) {
+ Tcl_DStringAppend(dstringPtr, string, -1);
+ }
+ va_end(argList);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Table_PostscriptCmd --
+ *
+ * This procedure is invoked to process the "postscript" options
+ * of the widget command for table widgets. See the user
+ * documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+int
+Table_PostscriptCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Information about table widget. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of argument objects. */
+ Tcl_Obj *CONST objv[];
+{
+#ifdef _WIN32
+ /*
+ * At the moment, it just doesn't like this code...
+ */
+ return TCL_OK;
+#else
+ register Table *tablePtr = (Table *) clientData;
+ TkPostscriptInfo psInfo, *oldInfoPtr;
+ int result;
+ int row, col, firstRow, firstCol, lastRow, lastCol;
+ /* dimensions of first and last cell to output */
+ int x0, y0, w0, h0, xn, yn, wn, hn;
+ int x, y, w, h, i;
+#define STRING_LENGTH 400
+ char string[STRING_LENGTH+1], *p, **argv;
+ size_t length;
+ int deltaX = 0, deltaY = 0; /* Offset of lower-left corner of area to
+ * be marked up, measured in table units
+ * from the positioning point on the page
+ * (reflects anchor position). Initial
+ * values needed only to stop compiler
+ * warnings. */
+ Tcl_HashSearch search;
+ Tcl_HashEntry *hPtr;
+ CONST char * CONST *chunk;
+ Tk_TextLayout textLayout = NULL;
+ char *value;
+ int rowHeight, total, *colWidths, iW, iH;
+ TableTag *tagPtr, *colPtr, *rowPtr, *titlePtr;
+ Tcl_DString postscript, buffer;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?option value ...?");
+ return TCL_ERROR;
+ }
+
+ /*
+ *----------------------------------------------------------------
+ * Initialize the data structure describing Postscript generation,
+ * then process all the arguments to fill the data structure in.
+ *----------------------------------------------------------------
+ */
+
+ Tcl_DStringInit(&postscript);
+ Tcl_DStringInit(&buffer);
+ oldInfoPtr = tablePtr->psInfoPtr;
+ tablePtr->psInfoPtr = &psInfo;
+ /* This is where in the window that we start printing from */
+ psInfo.x = 0;
+ psInfo.y = 0;
+ psInfo.width = -1;
+ psInfo.height = -1;
+ psInfo.pageXString = NULL;
+ psInfo.pageYString = NULL;
+ psInfo.pageX = 72*4.25;
+ psInfo.pageY = 72*5.5;
+ psInfo.pageWidthString = NULL;
+ psInfo.pageHeightString = NULL;
+ psInfo.scale = 1.0;
+ psInfo.pageAnchor = TK_ANCHOR_CENTER;
+ psInfo.rotate = 0;
+ psInfo.fontVar = NULL;
+ psInfo.colorVar = NULL;
+ psInfo.colorMode = NULL;
+ psInfo.colorLevel = 0;
+ psInfo.fileName = NULL;
+ psInfo.channelName = NULL;
+ psInfo.chan = NULL;
+ psInfo.first = NULL;
+ psInfo.last = NULL;
+ Tcl_InitHashTable(&psInfo.fontTable, TCL_STRING_KEYS);
+
+ /*
+ * The magic StringifyObjects
+ */
+ argv = (char **) ckalloc((objc + 1) * sizeof(char *));
+ for (i = 0; i < objc; i++)
+ argv[i] = Tcl_GetString(objv[i]);
+ argv[i] = NULL;
+
+ result = Tk_ConfigureWidget(interp, tablePtr->tkwin, configSpecs,
+ objc-2, argv+2, (char *) &psInfo,
+ TK_CONFIG_ARGV_ONLY);
+ if (result != TCL_OK) {
+ goto cleanup;
+ }
+
+ if (psInfo.first == NULL) {
+ firstRow = 0;
+ firstCol = 0;
+ } else if (TableGetIndex(tablePtr, psInfo.first, &firstRow, &firstCol)
+ != TCL_OK) {
+ result = TCL_ERROR;
+ goto cleanup;
+ }
+ if (psInfo.last == NULL) {
+ lastRow = tablePtr->rows-1;
+ lastCol = tablePtr->cols-1;
+ } else if (TableGetIndex(tablePtr, psInfo.last, &lastRow, &lastCol)
+ != TCL_OK) {
+ result = TCL_ERROR;
+ goto cleanup;
+ }
+
+ if (psInfo.fileName != NULL) {
+ /* Check that -file and -channel are not both specified. */
+ if (psInfo.channelName != NULL) {
+ Tcl_AppendResult(interp, "can't specify both -file",
+ " and -channel", (char *) NULL);
+ result = TCL_ERROR;
+ goto cleanup;
+ }
+
+ /*
+ * Check that we are not in a safe interpreter. If we are, disallow
+ * the -file specification.
+ */
+ if (Tcl_IsSafe(interp)) {
+ Tcl_AppendResult(interp, "can't specify -file in a",
+ " safe interpreter", (char *) NULL);
+ result = TCL_ERROR;
+ goto cleanup;
+ }
+
+ p = Tcl_TranslateFileName(interp, psInfo.fileName, &buffer);
+ if (p == NULL) {
+ result = TCL_ERROR;
+ goto cleanup;
+ }
+ psInfo.chan = Tcl_OpenFileChannel(interp, p, "w", 0666);
+ Tcl_DStringFree(&buffer);
+ Tcl_DStringInit(&buffer);
+ if (psInfo.chan == NULL) {
+ result = TCL_ERROR;
+ goto cleanup;
+ }
+ }
+
+ if (psInfo.channelName != NULL) {
+ int mode;
+ /*
+ * Check that the channel is found in this interpreter and that it
+ * is open for writing.
+ */
+ psInfo.chan = Tcl_GetChannel(interp, psInfo.channelName, &mode);
+ if (psInfo.chan == (Tcl_Channel) NULL) {
+ result = TCL_ERROR;
+ goto cleanup;
+ }
+ if ((mode & TCL_WRITABLE) == 0) {
+ Tcl_AppendResult(interp, "channel \"", psInfo.channelName,
+ "\" wasn't opened for writing", (char *) NULL);
+ result = TCL_ERROR;
+ goto cleanup;
+ }
+ }
+
+ if (psInfo.colorMode == NULL) {
+ psInfo.colorLevel = 2;
+ } else {
+ length = strlen(psInfo.colorMode);
+ if (strncmp(psInfo.colorMode, "monochrome", length) == 0) {
+ psInfo.colorLevel = 0;
+ } else if (strncmp(psInfo.colorMode, "gray", length) == 0) {
+ psInfo.colorLevel = 1;
+ } else if (strncmp(psInfo.colorMode, "color", length) == 0) {
+ psInfo.colorLevel = 2;
+ } else {
+ Tcl_AppendResult(interp, "bad color mode \"", psInfo.colorMode,
+ "\": must be monochrome, gray or color", (char *) NULL);
+ goto cleanup;
+ }
+ }
+
+ TableCellCoords(tablePtr, firstRow, firstCol, &x0, &y0, &w0, &h0);
+ TableCellCoords(tablePtr, lastRow, lastCol, &xn, &yn, &wn, &hn);
+ psInfo.x = x0;
+ psInfo.y = y0;
+ if (psInfo.width == -1) {
+ psInfo.width = xn+wn;
+ }
+ if (psInfo.height == -1) {
+ psInfo.height = yn+hn;
+ }
+ psInfo.x2 = psInfo.x + psInfo.width;
+ psInfo.y2 = psInfo.y + psInfo.height;
+
+ if (psInfo.pageXString != NULL) {
+ if (GetPostscriptPoints(interp, psInfo.pageXString,
+ &psInfo.pageX) != TCL_OK) {
+ goto cleanup;
+ }
+ }
+ if (psInfo.pageYString != NULL) {
+ if (GetPostscriptPoints(interp, psInfo.pageYString,
+ &psInfo.pageY) != TCL_OK) {
+ goto cleanup;
+ }
+ }
+ if (psInfo.pageWidthString != NULL) {
+ if (GetPostscriptPoints(interp, psInfo.pageWidthString,
+ &psInfo.scale) != TCL_OK) {
+ goto cleanup;
+ }
+ psInfo.scale /= psInfo.width;
+ } else if (psInfo.pageHeightString != NULL) {
+ if (GetPostscriptPoints(interp, psInfo.pageHeightString,
+ &psInfo.scale) != TCL_OK) {
+ goto cleanup;
+ }
+ psInfo.scale /= psInfo.height;
+ } else {
+ psInfo.scale = (72.0/25.4)*WidthMMOfScreen(Tk_Screen(tablePtr->tkwin))
+ / WidthOfScreen(Tk_Screen(tablePtr->tkwin));
+ }
+ switch (psInfo.pageAnchor) {
+ case TK_ANCHOR_NW:
+ case TK_ANCHOR_W:
+ case TK_ANCHOR_SW:
+ deltaX = 0;
+ break;
+ case TK_ANCHOR_N:
+ case TK_ANCHOR_CENTER:
+ case TK_ANCHOR_S:
+ deltaX = -psInfo.width/2;
+ break;
+ case TK_ANCHOR_NE:
+ case TK_ANCHOR_E:
+ case TK_ANCHOR_SE:
+ deltaX = -psInfo.width;
+ break;
+ }
+ switch (psInfo.pageAnchor) {
+ case TK_ANCHOR_NW:
+ case TK_ANCHOR_N:
+ case TK_ANCHOR_NE:
+ deltaY = - psInfo.height;
+ break;
+ case TK_ANCHOR_W:
+ case TK_ANCHOR_CENTER:
+ case TK_ANCHOR_E:
+ deltaY = -psInfo.height/2;
+ break;
+ case TK_ANCHOR_SW:
+ case TK_ANCHOR_S:
+ case TK_ANCHOR_SE:
+ deltaY = 0;
+ break;
+ }
+
+ /*
+ *--------------------------------------------------------
+ * Make a PREPASS over all of the tags
+ * to collect information about all the fonts in use, so that
+ * we can output font information in the proper form required
+ * by the Document Structuring Conventions.
+ *--------------------------------------------------------
+ */
+
+ Tk_TablePsFont(interp, tablePtr, tablePtr->defaultTag.tkfont);
+ Tcl_ResetResult(interp);
+ for (hPtr = Tcl_FirstHashEntry(tablePtr->tagTable, &search);
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ tagPtr = (TableTag *) Tcl_GetHashValue(hPtr);
+ if (tagPtr->tkfont != NULL) {
+ Tk_TablePsFont(interp, tablePtr, tagPtr->tkfont);
+ }
+ }
+ Tcl_ResetResult(interp);
+
+ /*
+ *--------------------------------------------------------
+ * Generate the header and prolog for the Postscript.
+ *--------------------------------------------------------
+ */
+
+ sprintf(string, " %d,%d => %d,%d\n", firstRow, firstCol, lastRow, lastCol);
+ Tcl_DStringAppendAll(&postscript,
+ "%!PS-Adobe-3.0 EPSF-3.0\n",
+ "%%Creator: Tk Table Widget ", TBL_VERSION, "\n",
+ "%%Title: Window ",
+ Tk_PathName(tablePtr->tkwin), string,
+ "%%BoundingBox: ",
+ (char *) NULL);
+ if (!psInfo.rotate) {
+ sprintf(string, "%d %d %d %d\n",
+ (int) (psInfo.pageX + psInfo.scale*deltaX),
+ (int) (psInfo.pageY + psInfo.scale*deltaY),
+ (int) (psInfo.pageX + psInfo.scale*(deltaX + psInfo.width)
+ + 1.0),
+ (int) (psInfo.pageY + psInfo.scale*(deltaY + psInfo.height)
+ + 1.0));
+ } else {
+ sprintf(string, "%d %d %d %d\n",
+ (int) (psInfo.pageX - psInfo.scale*(deltaY + psInfo.height)),
+ (int) (psInfo.pageY + psInfo.scale*deltaX),
+ (int) (psInfo.pageX - psInfo.scale*deltaY + 1.0),
+ (int) (psInfo.pageY + psInfo.scale*(deltaX + psInfo.width)
+ + 1.0));
+ }
+ Tcl_DStringAppendAll(&postscript, string,
+ "%%Pages: 1\n%%DocumentData: Clean7Bit\n",
+ "%%Orientation: ",
+ psInfo.rotate?"Landscape\n":"Portrait\n",
+ (char *) NULL);
+ p = "%%DocumentNeededResources: font ";
+ for (hPtr = Tcl_FirstHashEntry(&psInfo.fontTable, &search);
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ sprintf(string, "%s%s\n", p, Tcl_GetHashKey(&psInfo.fontTable, hPtr));
+ Tcl_DStringAppend(&postscript, string, -1);
+ p = "%%+ font ";
+ }
+ Tcl_DStringAppend(&postscript, "%%EndComments\n\n", -1);
+
+ /*
+ * Insert the prolog
+ */
+ for (chunk=prolog; *chunk; chunk++) {
+ Tcl_DStringAppend(&postscript, *chunk, -1);
+ }
+
+ if (psInfo.chan != NULL) {
+ Tcl_Write(psInfo.chan, Tcl_DStringValue(&postscript), -1);
+ Tcl_DStringFree(&postscript);
+ Tcl_DStringInit(&postscript);
+ }
+
+ /*
+ * Document setup: set the color level and include fonts.
+ * This is where we start using &postscript
+ */
+
+ sprintf(string, "/CL %d def\n", psInfo.colorLevel);
+ Tcl_DStringAppendAll(&postscript, "%%BeginSetup\n", string, (char *) NULL);
+ for (hPtr = Tcl_FirstHashEntry(&psInfo.fontTable, &search);
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ sprintf(string, "%s%s\n", "%%IncludeResource: font ",
+ Tcl_GetHashKey(&psInfo.fontTable, hPtr));
+ Tcl_DStringAppend(&postscript, string, -1);
+ }
+ Tcl_DStringAppend(&postscript, "%%EndSetup\n\n", -1);
+
+ /*
+ * Page setup: move to page positioning point, rotate if
+ * needed, set scale factor, offset for proper anchor position,
+ * and set clip region.
+ */
+
+ sprintf(string, "%.1f %.1f translate\n",
+ psInfo.pageX, psInfo.pageY);
+ Tcl_DStringAppendAll(&postscript, "%%Page: 1 1\nsave\n",
+ string, psInfo.rotate?"90 rotate\n":"",
+ (char *) NULL);
+ sprintf(string, "%.4g %.4g scale\n%d %d translate\n",
+ psInfo.scale, psInfo.scale, deltaX - psInfo.x, deltaY);
+ Tcl_DStringAppend(&postscript, string, -1);
+ sprintf(string, "%d %.15g moveto %d %.15g lineto %d %.15g lineto %d %.15g",
+ psInfo.x, (double) psInfo.y2-psInfo.y,
+ psInfo.x2,(double) psInfo.y2-psInfo.y,
+ psInfo.x2, 0.0, psInfo.x, 0.0);
+ Tcl_DStringAppend(&postscript, string, -1);
+ Tcl_DStringAppend(&postscript, " lineto closepath clip newpath\n", -1);
+ if (psInfo.chan != NULL) {
+ Tcl_Write(psInfo.chan, Tcl_DStringValue(&postscript), -1);
+ Tcl_DStringFree(&postscript);
+ Tcl_DStringInit(&postscript);
+ }
+
+ /*
+ * Go through each cell, calculating full desired height
+ */
+ result = TCL_OK;
+
+ hPtr = Tcl_FindHashEntry(tablePtr->tagTable, "title");
+ titlePtr = (TableTag *) Tcl_GetHashValue(hPtr);
+
+ total = 0;
+ colWidths = (int *) ckalloc((lastCol-firstCol) * sizeof(int));
+ for (col = 0; col <= lastCol-firstCol; col++) colWidths[col] = 0;
+ Tcl_DStringAppend(&buffer, "gsave\n", -1);
+ for (row = firstRow; row <= lastRow; row++) {
+ rowHeight = 0;
+ rowPtr = FindRowColTag(tablePtr, row+tablePtr->rowOffset, ROW);
+ for (col = firstCol; col <= lastCol; col++) {
+ /* get the coordinates for the cell */
+ TableCellCoords(tablePtr, row, col, &x, &y, &w, &h);
+ if ((x >= psInfo.x2) || (x+w < psInfo.x) ||
+ (y >= psInfo.y2) || (y+h < psInfo.y)) {
+ continue;
+ }
+
+ if (row == tablePtr->activeRow && col == tablePtr->activeCol) {
+ value = tablePtr->activeBuf;
+ } else {
+ value = TableGetCellValue(tablePtr, row+tablePtr->rowOffset,
+ col+tablePtr->colOffset);
+ }
+ if (!strlen(value)) {
+ continue;
+ }
+
+ /* Create the tag here */
+ tagPtr = TableNewTag();
+ /* First, merge in the default tag */
+ TableMergeTag(tagPtr, &(tablePtr->defaultTag));
+
+ colPtr = FindRowColTag(tablePtr, col+tablePtr->colOffset, COL);
+ if (colPtr != (TableTag *) NULL) TableMergeTag(tagPtr, colPtr);
+ if (rowPtr != (TableTag *) NULL) TableMergeTag(tagPtr, rowPtr);
+ /* Am I in the titles */
+ if (row < tablePtr->topRow || col < tablePtr->leftCol) {
+ TableMergeTag(tagPtr, titlePtr);
+ }
+ /* Does this have a cell tag */
+ TableMakeArrayIndex(row+tablePtr->rowOffset,
+ col+tablePtr->colOffset, string);
+ hPtr = Tcl_FindHashEntry(tablePtr->cellStyles, string);
+ if (hPtr != NULL) {
+ TableMergeTag(tagPtr, (TableTag *) Tcl_GetHashValue(hPtr));
+ }
+
+ /*
+ * the use of -1 instead of Tcl_NumUtfChars means we don't
+ * pass NULLs to postscript
+ */
+ textLayout = Tk_ComputeTextLayout(tagPtr->tkfont, value, -1,
+ (tagPtr->wrap>0) ? w : 0,
+ tagPtr->justify,
+ (tagPtr->multiline>0) ? 0 :
+ TK_IGNORE_NEWLINES, &iW, &iH);
+
+ rowHeight = MAX(rowHeight, iH);
+ colWidths[col-firstCol] = MAX(colWidths[col-firstCol], iW);
+
+ result = TextToPostscript(interp, tablePtr, tagPtr,
+ x, y, iW, iH, row, col, textLayout);
+ Tk_FreeTextLayout(textLayout);
+ if (result != TCL_OK) {
+ char msg[64 + TCL_INTEGER_SPACE];
+
+ sprintf(msg, "\n (generating Postscript for cell %s)",
+ string);
+ Tcl_AddErrorInfo(interp, msg);
+ goto cleanup;
+ }
+ Tcl_DStringAppend(&buffer, Tcl_GetStringResult(interp), -1);
+ }
+ sprintf(string, "/row%d %d def\n",
+ row, tablePtr->psInfoPtr->y2 - total);
+ Tcl_DStringAppend(&postscript, string, -1);
+ total += rowHeight + 2*tablePtr->defaultTag.bd;
+ }
+ Tcl_DStringAppend(&buffer, "grestore\n", -1);
+ sprintf(string, "/row%d %d def\n", row, tablePtr->psInfoPtr->y2 - total);
+ Tcl_DStringAppend(&postscript, string, -1);
+
+ total = tablePtr->defaultTag.bd;
+ for (col = firstCol; col <= lastCol; col++) {
+ sprintf(string, "/col%d %d def\n", col, total);
+ Tcl_DStringAppend(&postscript, string, -1);
+ total += colWidths[col-firstCol] + 2*tablePtr->defaultTag.bd;
+ }
+ sprintf(string, "/col%d %d def\n", col, total);
+ Tcl_DStringAppend(&postscript, string, -1);
+
+ Tcl_DStringAppend(&postscript, Tcl_DStringValue(&buffer), -1);
+
+ /*
+ * Output to channel at the end of it all
+ * This should more incremental, but that can't be avoided in order
+ * to post-define width/height of the cols/rows
+ */
+ if (psInfo.chan != NULL) {
+ Tcl_Write(psInfo.chan, Tcl_DStringValue(&postscript), -1);
+ Tcl_DStringFree(&postscript);
+ Tcl_DStringInit(&postscript);
+ }
+
+ /*
+ *---------------------------------------------------------------------
+ * Output page-end information, such as commands to print the page
+ * and document trailer stuff.
+ *---------------------------------------------------------------------
+ */
+
+ Tcl_DStringAppend(&postscript,
+ "restore showpage\n\n%%Trailer\nend\n%%EOF\n", -1);
+ if (psInfo.chan != NULL) {
+ Tcl_Write(psInfo.chan, Tcl_DStringValue(&postscript), -1);
+ Tcl_DStringFree(&postscript);
+ Tcl_DStringInit(&postscript);
+ }
+
+ /*
+ * Clean up psInfo to release malloc'ed stuff.
+ */
+
+cleanup:
+ ckfree((char *) argv);
+ Tcl_DStringResult(interp, &postscript);
+ Tcl_DStringFree(&postscript);
+ Tcl_DStringFree(&buffer);
+ if (psInfo.first != NULL) {
+ ckfree(psInfo.first);
+ }
+ if (psInfo.last != NULL) {
+ ckfree(psInfo.last);
+ }
+ if (psInfo.pageXString != NULL) {
+ ckfree(psInfo.pageXString);
+ }
+ if (psInfo.pageYString != NULL) {
+ ckfree(psInfo.pageYString);
+ }
+ if (psInfo.pageWidthString != NULL) {
+ ckfree(psInfo.pageWidthString);
+ }
+ if (psInfo.pageHeightString != NULL) {
+ ckfree(psInfo.pageHeightString);
+ }
+ if (psInfo.fontVar != NULL) {
+ ckfree(psInfo.fontVar);
+ }
+ if (psInfo.colorVar != NULL) {
+ ckfree(psInfo.colorVar);
+ }
+ if (psInfo.colorMode != NULL) {
+ ckfree(psInfo.colorMode);
+ }
+ if (psInfo.fileName != NULL) {
+ ckfree(psInfo.fileName);
+ }
+ if ((psInfo.chan != NULL) && (psInfo.channelName == NULL)) {
+ Tcl_Close(interp, psInfo.chan);
+ }
+ if (psInfo.channelName != NULL) {
+ ckfree(psInfo.channelName);
+ }
+ Tcl_DeleteHashTable(&psInfo.fontTable);
+ tablePtr->psInfoPtr = oldInfoPtr;
+ return result;
+#endif
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_TablePsColor --
+ *
+ * This procedure is called by individual table items when
+ * they want to set a color value for output. Given information
+ * about an X color, this procedure will generate Postscript
+ * commands to set up an appropriate color in Postscript.
+ *
+ * Results:
+ * Returns a standard Tcl return value. If an error occurs
+ * then an error message will be left in the interp's result.
+ * If no error occurs, then additional Postscript will be
+ * appended to the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_TablePsColor(interp, tablePtr, colorPtr)
+ Tcl_Interp *interp; /* Interpreter for returning Postscript
+ * or error message. */
+ Table *tablePtr; /* Information about table. */
+ XColor *colorPtr; /* Information about color. */
+{
+ TkPostscriptInfo *psInfoPtr = tablePtr->psInfoPtr;
+ int tmp;
+ double red, green, blue;
+ char string[200];
+
+ /*
+ * If there is a color map defined, then look up the color's name
+ * in the map and use the Postscript commands found there, if there
+ * are any.
+ */
+
+ if (psInfoPtr->colorVar != NULL) {
+ char *cmdString;
+
+ cmdString = Tcl_GetVar2(interp, psInfoPtr->colorVar,
+ Tk_NameOfColor(colorPtr), 0);
+ if (cmdString != NULL) {
+ Tcl_AppendResult(interp, cmdString, "\n", (char *) NULL);
+ return TCL_OK;
+ }
+ }
+
+ /*
+ * No color map entry for this color. Grab the color's intensities
+ * and output Postscript commands for them. Special note: X uses
+ * a range of 0-65535 for intensities, but most displays only use
+ * a range of 0-255, which maps to (0, 256, 512, ... 65280) in the
+ * X scale. This means that there's no way to get perfect white,
+ * since the highest intensity is only 65280 out of 65535. To
+ * work around this problem, rescale the X intensity to a 0-255
+ * scale and use that as the basis for the Postscript colors. This
+ * scheme still won't work if the display only uses 4 bits per color,
+ * but most diplays use at least 8 bits.
+ */
+
+ tmp = colorPtr->red;
+ red = ((double) (tmp >> 8))/255.0;
+ tmp = colorPtr->green;
+ green = ((double) (tmp >> 8))/255.0;
+ tmp = colorPtr->blue;
+ blue = ((double) (tmp >> 8))/255.0;
+ sprintf(string, "%.3f %.3f %.3f AdjustColor\n",
+ red, green, blue);
+ Tcl_AppendResult(interp, string, (char *) NULL);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_TablePsFont --
+ *
+ * This procedure is called by individual table items when
+ * they want to output text. Given information about an X
+ * font, this procedure will generate Postscript commands
+ * to set up an appropriate font in Postscript.
+ *
+ * Results:
+ * Returns a standard Tcl return value. If an error occurs
+ * then an error message will be left in the interp's result.
+ * If no error occurs, then additional Postscript will be
+ * appended to the interp's result.
+ *
+ * Side effects:
+ * The Postscript font name is entered into psInfoPtr->fontTable
+ * if it wasn't already there.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_TablePsFont(interp, tablePtr, tkfont)
+ Tcl_Interp *interp; /* Interpreter for returning Postscript
+ * or error message. */
+ Table *tablePtr; /* Information about table. */
+ Tk_Font tkfont; /* Information about font in which text
+ * is to be printed. */
+{
+ TkPostscriptInfo *psInfoPtr = tablePtr->psInfoPtr;
+ char *end;
+ char pointString[TCL_INTEGER_SPACE];
+ Tcl_DString ds;
+ int i, points;
+
+ /*
+ * First, look up the font's name in the font map, if there is one.
+ * If there is an entry for this font, it consists of a list
+ * containing font name and size. Use this information.
+ */
+
+ Tcl_DStringInit(&ds);
+
+ if (psInfoPtr->fontVar != NULL) {
+ char *list, **argv;
+ int objc;
+ double size;
+ char *name;
+
+ name = Tk_NameOfFont(tkfont);
+ list = Tcl_GetVar2(interp, psInfoPtr->fontVar, name, 0);
+ if (list != NULL) {
+ if (Tcl_SplitList(interp, list, &objc, &argv) != TCL_OK) {
+ badMapEntry:
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "bad font map entry for \"", name,
+ "\": \"", list, "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (objc != 2) {
+ goto badMapEntry;
+ }
+ size = strtod(argv[1], &end);
+ if ((size <= 0) || (*end != 0)) {
+ goto badMapEntry;
+ }
+
+ Tcl_DStringAppend(&ds, argv[0], -1);
+ points = (int) size;
+
+ ckfree((char *) argv);
+ goto findfont;
+ }
+ }
+
+ points = Tk_PostscriptFontName(tkfont, &ds);
+
+findfont:
+ sprintf(pointString, "%d", points);
+ Tcl_AppendResult(interp, pointString, " /", Tcl_DStringValue(&ds),
+ " SetFont\n", (char *) NULL);
+ Tcl_CreateHashEntry(&psInfoPtr->fontTable, Tcl_DStringValue(&ds), &i);
+ Tcl_DStringFree(&ds);
+
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * GetPostscriptPoints --
+ *
+ * Given a string, returns the number of Postscript points
+ * corresponding to that string.
+ *
+ * Results:
+ * The return value is a standard Tcl return result. If
+ * TCL_OK is returned, then everything went well and the
+ * screen distance is stored at *doublePtr; otherwise
+ * TCL_ERROR is returned and an error message is left in
+ * the interp's result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+GetPostscriptPoints(interp, string, doublePtr)
+ Tcl_Interp *interp; /* Use this for error reporting. */
+ char *string; /* String describing a screen distance. */
+ double *doublePtr; /* Place to store converted result. */
+{
+ char *end;
+ double d;
+
+ d = strtod(string, &end);
+ if (end == string) {
+ error:
+ Tcl_AppendResult(interp, "bad distance \"", string,
+ "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+#define UCHAR(c) ((unsigned char) (c))
+ while ((*end != '\0') && isspace(UCHAR(*end))) {
+ end++;
+ }
+ switch (*end) {
+ case 'c':
+ d *= 72.0/2.54;
+ end++;
+ break;
+ case 'i':
+ d *= 72.0;
+ end++;
+ break;
+ case 'm':
+ d *= 72.0/25.4;
+ end++;
+ break;
+ case 0:
+ break;
+ case 'p':
+ end++;
+ break;
+ default:
+ goto error;
+ }
+ while ((*end != '\0') && isspace(UCHAR(*end))) {
+ end++;
+ }
+ if (*end != 0) {
+ goto error;
+ }
+ *doublePtr = d;
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TextToPostscript --
+ *
+ * This procedure is called to generate Postscript for
+ * text items.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If an error
+ * occurs in generating Postscript then an error message is
+ * left in the interp's result, replacing whatever used
+ * to be there. If no error occurs, then Postscript for the
+ * item is appended to the result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+TextToPostscript(interp, tablePtr, tagPtr, tagX, tagY, width, height,
+ row, col, textLayout)
+ Tcl_Interp *interp; /* Leave Postscript or error message here. */
+ Table *tablePtr; /* Information about overall canvas. */
+ TableTag *tagPtr; /* */
+ int tagX, tagY; /* */
+ int width, height; /* */
+ int row, col; /* */
+ Tk_TextLayout textLayout; /* */
+{
+ int x, y;
+ Tk_FontMetrics fm;
+ char *justify;
+ char buffer[500];
+ Tk_3DBorder fg = tagPtr->fg;
+
+ if (fg == NULL) {
+ fg = tablePtr->defaultTag.fg;
+ }
+
+ if (Tk_TablePsFont(interp, tablePtr, tagPtr->tkfont) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (Tk_TablePsColor(interp, tablePtr, Tk_3DBorderColor(fg)) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ sprintf(buffer, "%% %.15g %.15g [\n", (tagX+width)/2.0,
+ tablePtr->psInfoPtr->y2 - ((tagY+height)/2.0));
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ sprintf(buffer, "col%d row%d [\n", col, row);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+
+ Tk_TextLayoutToPostscript(interp, textLayout);
+
+ x = 0; y = 0; justify = NULL; /* lint. */
+ switch (tagPtr->anchor) {
+ case TK_ANCHOR_NW: x = 0; y = 0; break;
+ case TK_ANCHOR_N: x = 1; y = 0; break;
+ case TK_ANCHOR_NE: x = 2; y = 0; break;
+ case TK_ANCHOR_E: x = 2; y = 1; break;
+ case TK_ANCHOR_SE: x = 2; y = 2; break;
+ case TK_ANCHOR_S: x = 1; y = 2; break;
+ case TK_ANCHOR_SW: x = 0; y = 2; break;
+ case TK_ANCHOR_W: x = 0; y = 1; break;
+ case TK_ANCHOR_CENTER: x = 1; y = 1; break;
+ }
+ switch (tagPtr->justify) {
+ case TK_JUSTIFY_RIGHT: justify = "1"; break;
+ case TK_JUSTIFY_CENTER: justify = "0.5";break;
+ case TK_JUSTIFY_LEFT: justify = "0";
+ }
+
+ Tk_GetFontMetrics(tagPtr->tkfont, &fm);
+ sprintf(buffer, "] %d %g %g %s %d %d DrawCellText\n",
+ fm.linespace, (x / -2.0), (y / 2.0), justify,
+ width, height);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+
+ return TCL_OK;
+}
diff --git a/tktable/generic/tkTableTag.c b/tktable/generic/tkTableTag.c
new file mode 100644
index 0000000..028984a
--- /dev/null
+++ b/tktable/generic/tkTableTag.c
@@ -0,0 +1,1354 @@
+/*
+ * tkTableTag.c --
+ *
+ * This module implements tags for table widgets.
+ *
+ * Copyright (c) 1998-2002 Jeffrey Hobbs
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id: tkTableTag.c,v 1.15 2008/11/14 22:46:57 hobbs Exp $
+ */
+
+#include "tkTable.h"
+
+static TableTag *TableTagGetEntry _ANSI_ARGS_((Table *tablePtr, char *name,
+ int objc, CONST char **argv));
+static unsigned int TableTagGetPriority _ANSI_ARGS_((Table *tablePtr,
+ TableTag *tagPtr));
+static void TableImageProc _ANSI_ARGS_((ClientData clientData, int x,
+ int y, int width, int height, int imageWidth, int imageHeight));
+static int TableOptionReliefSet _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, Tk_Window tkwin,
+ CONST84 char *value, char *widgRec, int offset));
+static char * TableOptionReliefGet _ANSI_ARGS_((ClientData clientData,
+ Tk_Window tkwin, char *widgRec, int offset,
+ Tcl_FreeProc **freeProcPtr));
+
+static CONST84 char *tagCmdNames[] = {
+ "celltag", "cget", "coltag", "configure", "delete", "exists",
+ "includes", "lower", "names", "raise", "rowtag", (char *) NULL
+};
+
+enum tagCmd {
+ TAG_CELLTAG, TAG_CGET, TAG_COLTAG, TAG_CONFIGURE, TAG_DELETE, TAG_EXISTS,
+ TAG_INCLUDES, TAG_LOWER, TAG_NAMES, TAG_RAISE, TAG_ROWTAG
+};
+
+static Cmd_Struct tagState_vals[]= {
+ {"unknown", STATE_UNKNOWN},
+ {"normal", STATE_NORMAL},
+ {"disabled", STATE_DISABLED},
+ {"", 0 }
+};
+
+static Tk_CustomOption tagStateOpt =
+{ Cmd_OptionSet, Cmd_OptionGet, (ClientData) (&tagState_vals) };
+static Tk_CustomOption tagBdOpt =
+{ TableOptionBdSet, TableOptionBdGet, (ClientData) BD_TABLE_TAG };
+static Tk_CustomOption tagReliefOpt =
+{ TableOptionReliefSet, TableOptionReliefGet, (ClientData) NULL };
+
+/*
+ * The default specification for configuring tags
+ * Done like this to make the command line parsing easy
+ */
+
+static Tk_ConfigSpec tagConfig[] = {
+ {TK_CONFIG_ANCHOR, "-anchor", "anchor", "Anchor", "center",
+ Tk_Offset(TableTag, anchor), TK_CONFIG_DONT_SET_DEFAULT|TK_CONFIG_NULL_OK },
+ {TK_CONFIG_BORDER, "-background", "background", "Background", NULL,
+ Tk_Offset(TableTag, bg), TK_CONFIG_DONT_SET_DEFAULT|TK_CONFIG_NULL_OK },
+ {TK_CONFIG_SYNONYM, "-bd", "borderWidth", (char *)NULL, (char *)NULL, 0, 0},
+ {TK_CONFIG_SYNONYM, "-bg", "background", (char *)NULL, (char *)NULL, 0, 0},
+ {TK_CONFIG_CUSTOM, "-borderwidth", "borderWidth", "BorderWidth", "",
+ 0 /* no offset */,
+ TK_CONFIG_DONT_SET_DEFAULT|TK_CONFIG_NULL_OK, &tagBdOpt },
+ {TK_CONFIG_STRING, "-ellipsis", "ellipsis", "Ellipsis", "",
+ Tk_Offset(TableTag, ellipsis), TK_CONFIG_DONT_SET_DEFAULT|TK_CONFIG_NULL_OK },
+ {TK_CONFIG_BORDER, "-foreground", "foreground", "Foreground", NULL,
+ Tk_Offset(TableTag, fg), TK_CONFIG_DONT_SET_DEFAULT|TK_CONFIG_NULL_OK },
+ {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *)NULL, (char *)NULL, 0, 0},
+ {TK_CONFIG_FONT, "-font", "font", "Font", NULL,
+ Tk_Offset(TableTag, tkfont), TK_CONFIG_DONT_SET_DEFAULT|TK_CONFIG_NULL_OK },
+ {TK_CONFIG_STRING, "-image", "image", "Image", NULL,
+ Tk_Offset(TableTag, imageStr),
+ TK_CONFIG_DONT_SET_DEFAULT|TK_CONFIG_NULL_OK },
+ {TK_CONFIG_JUSTIFY, "-justify", "justify", "Justify", "left",
+ Tk_Offset(TableTag, justify), TK_CONFIG_DONT_SET_DEFAULT|TK_CONFIG_NULL_OK },
+ {TK_CONFIG_INT, "-multiline", "multiline", "Multiline", "-1",
+ Tk_Offset(TableTag, multiline), TK_CONFIG_DONT_SET_DEFAULT },
+ {TK_CONFIG_CUSTOM, "-relief", "relief", "Relief", "flat",
+ Tk_Offset(TableTag, relief), TK_CONFIG_DONT_SET_DEFAULT|TK_CONFIG_NULL_OK,
+ &tagReliefOpt },
+ {TK_CONFIG_INT, "-showtext", "showText", "ShowText", "-1",
+ Tk_Offset(TableTag, showtext), TK_CONFIG_DONT_SET_DEFAULT },
+ {TK_CONFIG_CUSTOM, "-state", "state", "State", "unknown",
+ Tk_Offset(TableTag, state), TK_CONFIG_DONT_SET_DEFAULT, &tagStateOpt },
+ {TK_CONFIG_INT, "-wrap", "wrap", "Wrap", "-1",
+ Tk_Offset(TableTag, wrap), TK_CONFIG_DONT_SET_DEFAULT },
+ {TK_CONFIG_END, (char *)NULL, (char *)NULL, (char *)NULL, (char *)NULL, 0, 0}
+};
+
+/*
+ * The join tag structure is used to create a combined tag, so it
+ * keeps priority info.
+ */
+typedef struct {
+ TableTag tag; /* must be first */
+ unsigned int magic;
+ unsigned int pbg, pfg, pborders, prelief, ptkfont, panchor, pimage;
+ unsigned int pstate, pjustify, pmultiline, pwrap, pshowtext, pellipsis;
+} TableJoinTag;
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableImageProc --
+ * Called when an image associated with a tag is changed.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Invalidates the whole table.
+ * This should only invalidate affected cells, but that info
+ * is not managed...
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+TableImageProc(ClientData clientData, int x, int y, int width, int height,
+ int imageWidth, int imageHeight)
+{
+ TableInvalidateAll((Table *)clientData, 0);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableNewTag --
+ * ckallocs space for a new tag structure and inits the structure.
+ *
+ * Results:
+ * Returns a pointer to the new structure. Must be freed later.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+TableTag *
+TableNewTag(Table *tablePtr)
+{
+ TableTag *tagPtr;
+
+ /*
+ * If tablePtr is NULL, make a regular tag, otherwise make a join tag.
+ */
+ if (tablePtr == NULL) {
+ tagPtr = (TableTag *) ckalloc(sizeof(TableTag));
+ memset((VOID *) tagPtr, 0, sizeof(TableTag));
+
+ /*
+ * Set the values that aren't 0/NULL by default
+ */
+ tagPtr->anchor = (Tk_Anchor)-1;
+ tagPtr->justify = (Tk_Justify)-1;
+ tagPtr->multiline = -1;
+ tagPtr->relief = -1;
+ tagPtr->showtext = -1;
+ tagPtr->state = STATE_UNKNOWN;
+ tagPtr->wrap = -1;
+ } else {
+ TableJoinTag *jtagPtr = (TableJoinTag *) ckalloc(sizeof(TableJoinTag));
+ memset((VOID *) jtagPtr, 0, sizeof(TableJoinTag));
+ tagPtr = (TableTag *) jtagPtr;
+
+ tagPtr->anchor = (Tk_Anchor)-1;
+ tagPtr->justify = (Tk_Justify)-1;
+ tagPtr->multiline = -1;
+ tagPtr->relief = -1;
+ tagPtr->showtext = -1;
+ tagPtr->state = STATE_UNKNOWN;
+ tagPtr->wrap = -1;
+ jtagPtr->magic = 0x99ABCDEF;
+ jtagPtr->pbg = -1;
+ jtagPtr->pfg = -1;
+ jtagPtr->pborders = -1;
+ jtagPtr->prelief = -1;
+ jtagPtr->ptkfont = -1;
+ jtagPtr->panchor = -1;
+ jtagPtr->pimage = -1;
+ jtagPtr->pstate = -1;
+ jtagPtr->pjustify = -1;
+ jtagPtr->pmultiline = -1;
+ jtagPtr->pwrap = -1;
+ jtagPtr->pshowtext = -1;
+ jtagPtr->pellipsis = -1;
+ }
+
+ return (TableTag *) tagPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableResetTag --
+ * This routine resets a given tag to the table defaults.
+ *
+ * Results:
+ * Tag will have values changed.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+void
+TableResetTag(Table *tablePtr, TableTag *tagPtr)
+{
+ TableJoinTag *jtagPtr = (TableJoinTag *) tagPtr;
+
+ if (jtagPtr->magic != 0x99ABCDEF) {
+ panic("bad mojo in TableResetTag");
+ }
+
+ memset((VOID *) jtagPtr, 0, sizeof(TableJoinTag));
+
+ tagPtr->anchor = (Tk_Anchor)-1;
+ tagPtr->justify = (Tk_Justify)-1;
+ tagPtr->multiline = -1;
+ tagPtr->relief = -1;
+ tagPtr->showtext = -1;
+ tagPtr->state = STATE_UNKNOWN;
+ tagPtr->wrap = -1;
+ jtagPtr->magic = 0x99ABCDEF;
+ jtagPtr->pbg = -1;
+ jtagPtr->pfg = -1;
+ jtagPtr->pborders = -1;
+ jtagPtr->prelief = -1;
+ jtagPtr->ptkfont = -1;
+ jtagPtr->panchor = -1;
+ jtagPtr->pimage = -1;
+ jtagPtr->pstate = -1;
+ jtagPtr->pjustify = -1;
+ jtagPtr->pmultiline = -1;
+ jtagPtr->pwrap = -1;
+ jtagPtr->pshowtext = -1;
+ jtagPtr->pellipsis = -1;
+
+ /*
+ * Merge in the default tag.
+ */
+ memcpy((VOID *) jtagPtr, (VOID *) &(tablePtr->defaultTag),
+ sizeof(TableTag));
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableMergeTag --
+ * This routine merges two tags by adding any fields from the addTag
+ * that are set to the baseTag.
+ *
+ * Results:
+ * baseTag will inherit all set characteristics of addTag
+ * (addTag thus has the priority).
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+void
+TableMergeTag(Table *tablePtr, TableTag *baseTag, TableTag *addTag)
+{
+ TableJoinTag *jtagPtr = (TableJoinTag *) baseTag;
+ unsigned int prio;
+
+ if (jtagPtr->magic != 0x99ABCDEF) {
+ panic("bad mojo in TableMergeTag");
+ }
+
+#ifndef NO_TAG_PRIORITIES
+ /*
+ * Find priority for the tag to merge
+ */
+ prio = TableTagGetPriority(tablePtr, addTag);
+
+ if ((addTag->anchor != -1) && (prio < jtagPtr->panchor)) {
+ baseTag->anchor = addTag->anchor;
+ jtagPtr->panchor = prio;
+ }
+ if ((addTag->bg != NULL) && (prio < jtagPtr->pbg)) {
+ baseTag->bg = addTag->bg;
+ jtagPtr->pbg = prio;
+ }
+ if ((addTag->fg != NULL) && (prio < jtagPtr->pfg)) {
+ baseTag->fg = addTag->fg;
+ jtagPtr->pfg = prio;
+ }
+ if ((addTag->ellipsis != NULL) && (prio < jtagPtr->pellipsis)) {
+ baseTag->ellipsis = addTag->ellipsis;
+ jtagPtr->pellipsis = prio;
+ }
+ if ((addTag->tkfont != NULL) && (prio < jtagPtr->ptkfont)) {
+ baseTag->tkfont = addTag->tkfont;
+ jtagPtr->ptkfont = prio;
+ }
+ if ((addTag->imageStr != NULL) && (prio < jtagPtr->pimage)) {
+ baseTag->imageStr = addTag->imageStr;
+ baseTag->image = addTag->image;
+ jtagPtr->pimage = prio;
+ }
+ if ((addTag->multiline >= 0) && (prio < jtagPtr->pmultiline)) {
+ baseTag->multiline = addTag->multiline;
+ jtagPtr->pmultiline = prio;
+ }
+ if ((addTag->relief != -1) && (prio < jtagPtr->prelief)) {
+ baseTag->relief = addTag->relief;
+ jtagPtr->prelief = prio;
+ }
+ if ((addTag->showtext >= 0) && (prio < jtagPtr->pshowtext)) {
+ baseTag->showtext = addTag->showtext;
+ jtagPtr->pshowtext = prio;
+ }
+ if ((addTag->state != STATE_UNKNOWN) && (prio < jtagPtr->pstate)) {
+ baseTag->state = addTag->state;
+ jtagPtr->pstate = prio;
+ }
+ if ((addTag->justify != -1) && (prio < jtagPtr->pjustify)) {
+ baseTag->justify = addTag->justify;
+ jtagPtr->pjustify = prio;
+ }
+ if ((addTag->wrap >= 0) && (prio < jtagPtr->pwrap)) {
+ baseTag->wrap = addTag->wrap;
+ jtagPtr->pwrap = prio;
+ }
+ if ((addTag->borders) && (prio < jtagPtr->pborders)) {
+ baseTag->borderStr = addTag->borderStr;
+ baseTag->borders = addTag->borders;
+ baseTag->bd[0] = addTag->bd[0];
+ baseTag->bd[1] = addTag->bd[1];
+ baseTag->bd[2] = addTag->bd[2];
+ baseTag->bd[3] = addTag->bd[3];
+ jtagPtr->pborders = prio;
+ }
+#else
+ if (addTag->anchor != -1) baseTag->anchor = addTag->anchor;
+ if (addTag->bg != NULL) baseTag->bg = addTag->bg;
+ if (addTag->fg != NULL) baseTag->fg = addTag->fg;
+ if (addTag->ellipsis != NULL) baseTag->ellipsis = addTag->ellipsis;
+ if (addTag->tkfont != NULL) baseTag->tkfont = addTag->tkfont;
+ if (addTag->imageStr != NULL) {
+ baseTag->imageStr = addTag->imageStr;
+ baseTag->image = addTag->image;
+ }
+ if (addTag->multiline >= 0) baseTag->multiline = addTag->multiline;
+ if (addTag->relief != -1) baseTag->relief = addTag->relief;
+ if (addTag->showtext >= 0) baseTag->showtext = addTag->showtext;
+ if (addTag->state != STATE_UNKNOWN) baseTag->state = addTag->state;
+ if (addTag->justify != -1) baseTag->justify = addTag->justify;
+ if (addTag->wrap >= 0) baseTag->wrap = addTag->wrap;
+ if (addTag->borders) {
+ baseTag->borderStr = addTag->borderStr;
+ baseTag->borders = addTag->borders;
+ baseTag->bd[0] = addTag->bd[0];
+ baseTag->bd[1] = addTag->bd[1];
+ baseTag->bd[2] = addTag->bd[2];
+ baseTag->bd[3] = addTag->bd[3];
+ }
+#endif
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableInvertTag --
+ * This routine swaps background and foreground for the selected tag.
+ *
+ * Results:
+ * Inverts fg and bg of tag.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+void
+TableInvertTag(TableTag *baseTag)
+{
+ Tk_3DBorder tmpBg;
+
+ tmpBg = baseTag->fg;
+ baseTag->fg = baseTag->bg;
+ baseTag->bg = tmpBg;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableGetTagBorders --
+ * This routine gets the border values based on a tag.
+ *
+ * Results:
+ * It returns the values in the int*'s (if not NULL), and the
+ * total number of defined borders as a result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+int
+TableGetTagBorders(TableTag *tagPtr,
+ int *left, int *right, int *top, int *bottom)
+{
+ switch (tagPtr->borders) {
+ case 0:
+ if (left) { *left = 0; }
+ if (right) { *right = 0; }
+ if (top) { *top = 0; }
+ if (bottom) { *bottom = 0; }
+ break;
+ case 1:
+ if (left) { *left = tagPtr->bd[0]; }
+ if (right) { *right = tagPtr->bd[0]; }
+ if (top) { *top = tagPtr->bd[0]; }
+ if (bottom) { *bottom = tagPtr->bd[0]; }
+ break;
+ case 2:
+ if (left) { *left = tagPtr->bd[0]; }
+ if (right) { *right = tagPtr->bd[1]; }
+ if (top) { *top = 0; }
+ if (bottom) { *bottom = 0; }
+ break;
+ case 4:
+ if (left) { *left = tagPtr->bd[0]; }
+ if (right) { *right = tagPtr->bd[1]; }
+ if (top) { *top = tagPtr->bd[2]; }
+ if (bottom) { *bottom = tagPtr->bd[3]; }
+ break;
+ default:
+ panic("invalid border value '%d'\n", tagPtr->borders);
+ break;
+ }
+ return tagPtr->borders;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableTagGetEntry --
+ * Takes a name and optional args and creates a tag entry in the
+ * table's tag table.
+ *
+ * Results:
+ * A new tag entry will be created and returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+static TableTag *
+TableTagGetEntry(Table *tablePtr, char *name, int objc, CONST char **argv)
+{
+ Tcl_HashEntry *entryPtr;
+ TableTag *tagPtr = NULL;
+ int new;
+
+ entryPtr = Tcl_CreateHashEntry(tablePtr->tagTable, name, &new);
+ if (new) {
+ tagPtr = TableNewTag(NULL);
+ Tcl_SetHashValue(entryPtr, (ClientData) tagPtr);
+ if (tablePtr->tagPrioSize >= tablePtr->tagPrioMax) {
+ int i;
+ /*
+ * Increase the priority list size in blocks of 10
+ */
+ tablePtr->tagPrioMax += 10;
+ tablePtr->tagPrioNames = (char **) ckrealloc(
+ (char *) tablePtr->tagPrioNames,
+ sizeof(TableTag *) * tablePtr->tagPrioMax);
+ tablePtr->tagPrios = (TableTag **) ckrealloc(
+ (char *) tablePtr->tagPrios,
+ sizeof(TableTag *) * tablePtr->tagPrioMax);
+ for (i = tablePtr->tagPrioSize; i < tablePtr->tagPrioMax; i++) {
+ tablePtr->tagPrioNames[i] = (char *) NULL;
+ tablePtr->tagPrios[i] = (TableTag *) NULL;
+ }
+ }
+ tablePtr->tagPrioNames[tablePtr->tagPrioSize] =
+ (char *) Tcl_GetHashKey(tablePtr->tagTable, entryPtr);
+ tablePtr->tagPrios[tablePtr->tagPrioSize] = tagPtr;
+ tablePtr->tagPrioSize++;
+ } else {
+ tagPtr = (TableTag *) Tcl_GetHashValue(entryPtr);
+ }
+ if (objc) {
+ Tk_ConfigureWidget(tablePtr->interp, tablePtr->tkwin, tagConfig,
+ objc, (CONST84 char **) argv, (char *)tagPtr,
+ TK_CONFIG_ARGV_ONLY);
+ }
+ return tagPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableTagGetPriority --
+ * Get the priority value for a tag.
+ *
+ * Results:
+ * returns the priority.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+static unsigned int
+TableTagGetPriority(Table *tablePtr, TableTag *tagPtr)
+{
+ unsigned int prio = 0;
+ while (tagPtr != tablePtr->tagPrios[prio]) { prio++; }
+ return prio;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableInitTags --
+ * Creates the static table tags.
+ *
+ * Results:
+ * active, sel, title and flash are created as tags.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+void
+TableInitTags(Table *tablePtr)
+{
+ static CONST char *activeArgs[] = {"-bg", ACTIVE_BG, "-relief", "flat" };
+ static CONST char *selArgs[] = {"-bg", SELECT_BG, "-fg", SELECT_FG,
+ "-relief", "sunken" };
+ static CONST char *titleArgs[] = {"-bg", DISABLED, "-fg", "white",
+ "-relief", "flat",
+ "-state", "disabled" };
+ static CONST char *flashArgs[] = {"-bg", "red" };
+ /*
+ * The order of creation is important to priority.
+ */
+ TableTagGetEntry(tablePtr, "flash", ARSIZE(flashArgs), flashArgs);
+ TableTagGetEntry(tablePtr, "active", ARSIZE(activeArgs), activeArgs);
+ TableTagGetEntry(tablePtr, "sel", ARSIZE(selArgs), selArgs);
+ TableTagGetEntry(tablePtr, "title", ARSIZE(titleArgs), titleArgs);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FindRowColTag --
+ * Finds a row/col tag based on the row/col styles and tagCommand.
+ *
+ * Results:
+ * Returns tag associated with row/col cell, if any.
+ *
+ * Side effects:
+ * Possible side effects from eval of tagCommand.
+ * IMPORTANT: This plays with the interp result object,
+ * so use of resultPtr in prior command may be invalid after
+ * calling this function.
+ *
+ *----------------------------------------------------------------------
+ */
+TableTag *
+FindRowColTag(Table *tablePtr, int cell, int mode)
+{
+ Tcl_HashEntry *entryPtr;
+ TableTag *tagPtr = NULL;
+
+ entryPtr = Tcl_FindHashEntry((mode == ROW) ? tablePtr->rowStyles
+ : tablePtr->colStyles, (char *) cell);
+ if (entryPtr == NULL) {
+ char *cmd = (mode == ROW) ? tablePtr->rowTagCmd : tablePtr->colTagCmd;
+ if (cmd) {
+ register Tcl_Interp *interp = tablePtr->interp;
+ char buf[INDEX_BUFSIZE];
+ /*
+ * Since no specific row/col tag exists, eval the given command
+ * with row/col appended
+ */
+ sprintf(buf, " %d", cell);
+ Tcl_Preserve((ClientData) interp);
+ if (Tcl_VarEval(interp, cmd, buf, (char *)NULL) == TCL_OK) {
+ CONST char *name = Tcl_GetStringResult(interp);
+ if (name && *name) {
+ /*
+ * If a result was returned, check to see if it is
+ * a valid tag.
+ */
+ entryPtr = Tcl_FindHashEntry(tablePtr->tagTable, name);
+ }
+ }
+ Tcl_Release((ClientData) interp);
+ Tcl_ResetResult(interp);
+ }
+ }
+ if (entryPtr != NULL) {
+ /*
+ * This can be either the one in row|colStyles,
+ * or that returned by eval'ing the row|colTagCmd
+ */
+ tagPtr = (TableTag *) Tcl_GetHashValue(entryPtr);
+ }
+ return tagPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableCleanupTag --
+ * Releases the resources used by a tag before it is freed up.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The tag is no longer valid.
+ *
+ *----------------------------------------------------------------------
+ */
+void
+TableCleanupTag(Table *tablePtr, TableTag *tagPtr)
+{
+ /*
+ * Free resources that the optionSpec doesn't specifically know about
+ */
+ if (tagPtr->image) {
+ Tk_FreeImage(tagPtr->image);
+ }
+
+ Tk_FreeOptions(tagConfig, (char *) tagPtr, tablePtr->display, 0);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Table_TagCmd --
+ * This procedure is invoked to process the tag method
+ * that corresponds to a widget managed by this module.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+int
+Table_TagCmd(ClientData clientData, register Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[])
+{
+ register Table *tablePtr = (Table *)clientData;
+ int result = TCL_OK, cmdIndex, i, newEntry, value, len;
+ int row, col, tagPrio, refresh = 0;
+ TableTag *tagPtr, *tag2Ptr;
+ Tcl_HashEntry *entryPtr, *scanPtr;
+ Tcl_HashTable *hashTblPtr;
+ Tcl_HashSearch search;
+ Tk_Image image;
+ Tcl_Obj *objPtr, *resultPtr;
+ char buf[INDEX_BUFSIZE], *keybuf, *tagname;
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "option ?arg arg ...?");
+ return TCL_ERROR;
+ }
+
+ result = Tcl_GetIndexFromObj(interp, objv[2], tagCmdNames,
+ "tag option", 0, &cmdIndex);
+ if (result != TCL_OK) {
+ return result;
+ }
+ /*
+ * Before using this object, make sure there aren't any calls that
+ * could have changed the interp result, thus freeing the object.
+ */
+ resultPtr = Tcl_GetObjResult(interp);
+
+ switch ((enum tagCmd) cmdIndex) {
+ case TAG_CELLTAG: /* add named tag to a (group of) cell(s) */
+ if (objc < 4) {
+ Tcl_WrongNumArgs(interp, 3, objv, "tag ?arg arg ...?");
+ return TCL_ERROR;
+ }
+ tagname = Tcl_GetStringFromObj(objv[3], &len);
+ if (len == 0) {
+ /*
+ * An empty string was specified, so just delete the tag.
+ */
+ tagPtr = NULL;
+ } else {
+ /*
+ * Get the pointer to the tag structure. If it doesn't
+ * exist, it will be created.
+ */
+ tagPtr = TableTagGetEntry(tablePtr, tagname, 0, NULL);
+ }
+
+ if (objc == 4) {
+ /*
+ * The user just wants the cells with this tag returned.
+ * Handle specially tags named: active, flash, sel, title
+ */
+
+ if ((tablePtr->flags & HAS_ACTIVE) &&
+ STREQ(tagname, "active")) {
+ TableMakeArrayIndex(
+ tablePtr->activeRow+tablePtr->rowOffset,
+ tablePtr->activeCol+tablePtr->colOffset, buf);
+ Tcl_SetStringObj(resultPtr, buf, -1);
+ } else if ((tablePtr->flashMode && STREQ(tagname, "flash"))
+ || STREQ(tagname, "sel")) {
+ hashTblPtr = (*tagname == 's') ?
+ tablePtr->selCells : tablePtr->flashCells;
+ for (scanPtr = Tcl_FirstHashEntry(hashTblPtr, &search);
+ scanPtr != NULL;
+ scanPtr = Tcl_NextHashEntry(&search)) {
+ keybuf = (char *) Tcl_GetHashKey(hashTblPtr, scanPtr);
+ Tcl_ListObjAppendElement(NULL, resultPtr,
+ Tcl_NewStringObj(keybuf, -1));
+ }
+ } else if (STREQ(tagname, "title") &&
+ (tablePtr->titleRows || tablePtr->titleCols)) {
+ for (row = tablePtr->rowOffset;
+ row < tablePtr->rowOffset+tablePtr->rows; row++) {
+ for (col = tablePtr->colOffset;
+ col < tablePtr->colOffset+tablePtr->titleCols;
+ col++) {
+ TableMakeArrayIndex(row, col, buf);
+ Tcl_ListObjAppendElement(NULL, resultPtr,
+ Tcl_NewStringObj(buf, -1));
+ }
+ }
+ for (row = tablePtr->rowOffset;
+ row < tablePtr->rowOffset+tablePtr->titleRows;
+ row++) {
+ for (col = tablePtr->colOffset+tablePtr->titleCols;
+ col < tablePtr->colOffset+tablePtr->cols; col++) {
+ TableMakeArrayIndex(row, col, buf);
+ Tcl_ListObjAppendElement(NULL, resultPtr,
+ Tcl_NewStringObj(buf, -1));
+ }
+ }
+ } else {
+ /*
+ * Check this tag pointer amongst all tagged cells
+ */
+ for (scanPtr = Tcl_FirstHashEntry(tablePtr->cellStyles,
+ &search);
+ scanPtr != NULL;
+ scanPtr = Tcl_NextHashEntry(&search)) {
+ if ((TableTag *) Tcl_GetHashValue(scanPtr) == tagPtr) {
+ keybuf = (char *) Tcl_GetHashKey(
+ tablePtr->cellStyles, scanPtr);
+ Tcl_ListObjAppendElement(NULL, resultPtr,
+ Tcl_NewStringObj(keybuf, -1));
+ }
+ }
+ }
+ return TCL_OK;
+ }
+
+ /*
+ * Loop through the arguments and fill in the hash table
+ */
+ for (i = 4; i < objc; i++) {
+ /*
+ * Try and parse the index
+ */
+ if (TableGetIndexObj(tablePtr, objv[i], &row, &col)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ /*
+ * Get the hash key ready
+ */
+ TableMakeArrayIndex(row, col, buf);
+
+ if (tagPtr == NULL) {
+ /*
+ * This is a deletion
+ */
+ entryPtr = Tcl_FindHashEntry(tablePtr->cellStyles, buf);
+ if (entryPtr != NULL) {
+ Tcl_DeleteHashEntry(entryPtr);
+ refresh = 1;
+ }
+ } else {
+ /*
+ * Add a key to the hash table and set it to point to the
+ * Tag structure if it wasn't the same as an existing one
+ */
+ entryPtr = Tcl_CreateHashEntry(tablePtr->cellStyles,
+ buf, &newEntry);
+ if (newEntry || (tagPtr !=
+ (TableTag *) Tcl_GetHashValue(entryPtr))) {
+ Tcl_SetHashValue(entryPtr, (ClientData) tagPtr);
+ refresh = 1;
+ }
+ }
+ /*
+ * Now invalidate this cell for redraw
+ */
+ if (refresh) {
+ TableRefresh(tablePtr, row-tablePtr->rowOffset,
+ col-tablePtr->colOffset, CELL);
+ }
+ }
+ return TCL_OK;
+
+ case TAG_COLTAG:
+ case TAG_ROWTAG: { /* tag a row or a column */
+ int forRows = (cmdIndex == TAG_ROWTAG);
+
+ if (objc < 4) {
+ Tcl_WrongNumArgs(interp, 3, objv, "tag ?arg arg ..?");
+ return TCL_ERROR;
+ }
+ tagname = Tcl_GetStringFromObj(objv[3], &len);
+ if (len == 0) {
+ /*
+ * Empty string, so we want to delete this element
+ */
+ tagPtr = NULL;
+ } else {
+ /*
+ * Get the pointer to the tag structure. If it doesn't
+ * exist, it will be created.
+ */
+ tagPtr = TableTagGetEntry(tablePtr, tagname, 0, NULL);
+ }
+
+ /*
+ * Choose the correct hash table based on args
+ */
+ hashTblPtr = forRows ? tablePtr->rowStyles : tablePtr->colStyles;
+
+ if (objc == 4) {
+ /* the user just wants the tagged cells to be returned */
+ /* Special handling for tags: active, flash, sel, title */
+
+ if ((tablePtr->flags & HAS_ACTIVE) &&
+ strcmp(tagname, "active") == 0) {
+ Tcl_SetIntObj(resultPtr,
+ (forRows ?
+ tablePtr->activeRow+tablePtr->rowOffset :
+ tablePtr->activeCol+tablePtr->colOffset));
+ } else if ((tablePtr->flashMode && STREQ(tagname, "flash"))
+ || STREQ(tagname, "sel")) {
+ Tcl_HashTable *cacheTblPtr;
+
+ cacheTblPtr = (Tcl_HashTable *)
+ ckalloc(sizeof(Tcl_HashTable));
+ Tcl_InitHashTable(cacheTblPtr, TCL_ONE_WORD_KEYS);
+
+ hashTblPtr = (*tagname == 's') ?
+ tablePtr->selCells : tablePtr->flashCells;
+ for (scanPtr = Tcl_FirstHashEntry(hashTblPtr, &search);
+ scanPtr != NULL;
+ scanPtr = Tcl_NextHashEntry(&search)) {
+ TableParseArrayIndex(&row, &col,
+ Tcl_GetHashKey(hashTblPtr, scanPtr));
+ value = forRows ? row : col;
+ entryPtr = Tcl_CreateHashEntry(cacheTblPtr,
+ (char *)value, &newEntry);
+ if (newEntry) {
+ Tcl_ListObjAppendElement(NULL, resultPtr,
+ Tcl_NewIntObj(value));
+ }
+ }
+
+ Tcl_DeleteHashTable(cacheTblPtr);
+ ckfree((char *) (cacheTblPtr));
+ } else if (STREQ(tagname, "title") &&
+ (forRows?tablePtr->titleRows:tablePtr->titleCols)) {
+ if (forRows) {
+ for (row = tablePtr->rowOffset;
+ row < tablePtr->rowOffset+tablePtr->titleRows;
+ row++) {
+ Tcl_ListObjAppendElement(NULL, resultPtr,
+ Tcl_NewIntObj(row));
+ }
+ } else {
+ for (col = tablePtr->colOffset;
+ col < tablePtr->colOffset+tablePtr->titleCols;
+ col++) {
+ Tcl_ListObjAppendElement(NULL, resultPtr,
+ Tcl_NewIntObj(col));
+ }
+ }
+ } else {
+ for (scanPtr = Tcl_FirstHashEntry(hashTblPtr, &search);
+ scanPtr != NULL;
+ scanPtr = Tcl_NextHashEntry(&search)) {
+ /* is this the tag pointer on this row */
+ if ((TableTag *) Tcl_GetHashValue(scanPtr) == tagPtr) {
+ objPtr = Tcl_NewIntObj(
+ (int) Tcl_GetHashKey(hashTblPtr, scanPtr));
+ Tcl_ListObjAppendElement(NULL, resultPtr, objPtr);
+ }
+ }
+ }
+ return TCL_OK;
+ }
+
+ /*
+ * Loop through the arguments and fill in the hash table
+ */
+ for (i = 4; i < objc; i++) {
+ /*
+ * Try and parse the index
+ */
+ if (Tcl_GetIntFromObj(interp, objv[i], &value) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (tagPtr == NULL) {
+ /*
+ * This is a deletion
+ */
+ entryPtr = Tcl_FindHashEntry(hashTblPtr, (char *)value);
+ if (entryPtr != NULL) {
+ Tcl_DeleteHashEntry(entryPtr);
+ refresh = 1;
+ }
+ } else {
+ /*
+ * Add a key to the hash table and set it to point to the
+ * Tag structure if it wasn't the same as an existing one
+ */
+ entryPtr = Tcl_CreateHashEntry(hashTblPtr,
+ (char *) value, &newEntry);
+ if (newEntry || (tagPtr !=
+ (TableTag *) Tcl_GetHashValue(entryPtr))) {
+ Tcl_SetHashValue(entryPtr, (ClientData) tagPtr);
+ refresh = 1;
+ }
+ }
+ /* and invalidate the row or column affected */
+ if (refresh) {
+ if (cmdIndex == TAG_ROWTAG) {
+ TableRefresh(tablePtr, value-tablePtr->rowOffset, 0,
+ ROW);
+ } else {
+ TableRefresh(tablePtr, 0, value-tablePtr->colOffset,
+ COL);
+ }
+ }
+ }
+ return TCL_OK; /* COLTAG && ROWTAG */
+ }
+
+ case TAG_CGET:
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 3, objv, "tagName option");
+ return TCL_ERROR;
+ }
+ tagname = Tcl_GetString(objv[3]);
+ entryPtr = Tcl_FindHashEntry(tablePtr->tagTable, tagname);
+ if (entryPtr == NULL) {
+ goto invalidtag;
+ } else {
+ tagPtr = (TableTag *) Tcl_GetHashValue (entryPtr);
+ result = Tk_ConfigureValue(interp, tablePtr->tkwin, tagConfig,
+ (char *) tagPtr, Tcl_GetString(objv[4]), 0);
+ }
+ return result; /* CGET */
+
+ case TAG_CONFIGURE:
+ if (objc < 4) {
+ Tcl_WrongNumArgs(interp, 3, objv, "tagName ?arg arg ...?");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Get the pointer to the tag structure. If it doesn't
+ * exist, it will be created.
+ */
+ tagPtr = TableTagGetEntry(tablePtr, Tcl_GetString(objv[3]),
+ 0, NULL);
+
+ /*
+ * If there were less than 6 args, we return the configuration
+ * (for all or just one option), even for new tags
+ */
+ if (objc < 6) {
+ result = Tk_ConfigureInfo(interp, tablePtr->tkwin, tagConfig,
+ (char *) tagPtr, (objc == 5) ?
+ Tcl_GetString(objv[4]) : NULL, 0);
+ } else {
+ CONST84 char **argv;
+
+ /* Stringify */
+ argv = (CONST84 char **) ckalloc((objc + 1) * sizeof(char *));
+ for (i = 0; i < objc; i++)
+ argv[i] = Tcl_GetString(objv[i]);
+ argv[objc] = NULL;
+
+ result = Tk_ConfigureWidget(interp, tablePtr->tkwin,
+ tagConfig, objc-4, argv+4, (char *) tagPtr,
+ TK_CONFIG_ARGV_ONLY);
+ ckfree((char *) argv);
+ if (result == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Handle change of image name
+ */
+ if (tagPtr->imageStr) {
+ image = Tk_GetImage(interp, tablePtr->tkwin,
+ tagPtr->imageStr,
+ TableImageProc, (ClientData)tablePtr);
+ if (image == NULL) {
+ result = TCL_ERROR;
+ }
+ } else {
+ image = NULL;
+ }
+ if (tagPtr->image) {
+ Tk_FreeImage(tagPtr->image);
+ }
+ tagPtr->image = image;
+
+ /*
+ * We reconfigured, so invalidate the table to redraw
+ */
+ TableInvalidateAll(tablePtr, 0);
+ }
+ return result;
+
+ case TAG_DELETE:
+ /* delete a tag */
+ if (objc < 4) {
+ Tcl_WrongNumArgs(interp, 3, objv, "tagName ?tagName ...?");
+ return TCL_ERROR;
+ }
+ /* run through the remaining arguments */
+ for (i = 3; i < objc; i++) {
+ tagname = Tcl_GetString(objv[i]);
+ /* cannot delete the title tag */
+ if (STREQ(tagname, "title") ||
+ STREQ(tagname, "sel") ||
+ STREQ(tagname, "flash") ||
+ STREQ(tagname, "active")) {
+ Tcl_AppendStringsToObj(resultPtr, "cannot delete ",
+ tagname, " tag", (char *) NULL);
+ return TCL_ERROR;
+ }
+ entryPtr = Tcl_FindHashEntry(tablePtr->tagTable, tagname);
+ if (entryPtr != NULL) {
+ /* get the tag pointer */
+ tagPtr = (TableTag *) Tcl_GetHashValue(entryPtr);
+
+ /* delete all references to this tag in rows */
+ scanPtr = Tcl_FirstHashEntry(tablePtr->rowStyles, &search);
+ for (; scanPtr != NULL;
+ scanPtr = Tcl_NextHashEntry(&search)) {
+ if ((TableTag *)Tcl_GetHashValue(scanPtr) == tagPtr) {
+ Tcl_DeleteHashEntry(scanPtr);
+ refresh = 1;
+ }
+ }
+
+ /* delete all references to this tag in cols */
+ scanPtr = Tcl_FirstHashEntry(tablePtr->colStyles, &search);
+ for (; scanPtr != NULL;
+ scanPtr = Tcl_NextHashEntry(&search)) {
+ if ((TableTag *)Tcl_GetHashValue(scanPtr) == tagPtr) {
+ Tcl_DeleteHashEntry(scanPtr);
+ refresh = 1;
+ }
+ }
+
+ /* delete all references to this tag in cells */
+ scanPtr = Tcl_FirstHashEntry(tablePtr->cellStyles,
+ &search);
+ for (; scanPtr != NULL;
+ scanPtr = Tcl_NextHashEntry(&search)) {
+ if ((TableTag *)Tcl_GetHashValue(scanPtr) == tagPtr) {
+ Tcl_DeleteHashEntry(scanPtr);
+ refresh = 1;
+ }
+ }
+
+ /*
+ * Remove the tag from the prio list and collapse
+ * the rest of the tags. We could check for shrinking
+ * the prio list as well.
+ */
+ for (i = 0; i < tablePtr->tagPrioSize; i++) {
+ if (tablePtr->tagPrios[i] == tagPtr) break;
+ }
+ for ( ; i < tablePtr->tagPrioSize; i++) {
+ tablePtr->tagPrioNames[i] =
+ tablePtr->tagPrioNames[i+1];
+ tablePtr->tagPrios[i] = tablePtr->tagPrios[i+1];
+ }
+ tablePtr->tagPrioSize--;
+
+ /* Release the tag structure */
+ TableCleanupTag(tablePtr, tagPtr);
+ ckfree((char *) tagPtr);
+
+ /* And free the hash table entry */
+ Tcl_DeleteHashEntry(entryPtr);
+ }
+ }
+ /* since we deleted a tag, redraw the screen */
+ if (refresh) {
+ TableInvalidateAll(tablePtr, 0);
+ }
+ return result;
+
+ case TAG_EXISTS:
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 3, objv, "tagName");
+ return TCL_ERROR;
+ }
+ Tcl_SetBooleanObj(resultPtr,
+ (Tcl_FindHashEntry(tablePtr->tagTable,
+ Tcl_GetString(objv[3])) != NULL));
+ return TCL_OK;
+
+ case TAG_INCLUDES:
+ /* does a tag contain a index ? */
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 3, objv, "tag index");
+ return TCL_ERROR;
+ }
+ tagname = Tcl_GetString(objv[3]);
+ /* check to see if the tag actually exists */
+ entryPtr = Tcl_FindHashEntry(tablePtr->tagTable, tagname);
+ if (entryPtr == NULL) {
+ /* Unknown tag, just return 0 */
+ Tcl_SetBooleanObj(resultPtr, 0);
+ return TCL_OK;
+ }
+ /* parse index */
+ if (TableGetIndexObj(tablePtr, objv[4], &row, &col) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ /* create hash key */
+ TableMakeArrayIndex(row, col, buf);
+
+ if (STREQ(tagname, "active")) {
+ result = (tablePtr->activeRow+tablePtr->rowOffset==row &&
+ tablePtr->activeCol+tablePtr->colOffset==col);
+ } else if (STREQ(tagname, "flash")) {
+ result = (tablePtr->flashMode &&
+ (Tcl_FindHashEntry(tablePtr->flashCells, buf)
+ != NULL));
+ } else if (STREQ(tagname, "sel")) {
+ result = (Tcl_FindHashEntry(tablePtr->selCells, buf) != NULL);
+ } else if (STREQ(tagname, "title")) {
+ result = (row < tablePtr->titleRows+tablePtr->rowOffset ||
+ col < tablePtr->titleCols+tablePtr->colOffset);
+ } else {
+ /* get the pointer to the tag structure */
+ tagPtr = (TableTag *) Tcl_GetHashValue(entryPtr);
+ scanPtr = Tcl_FindHashEntry(tablePtr->cellStyles, buf);
+ /*
+ * Look to see if there is a cell, row, or col tag
+ * for this cell
+ */
+ result = ((scanPtr &&
+ (tagPtr == (TableTag *) Tcl_GetHashValue(scanPtr))) ||
+ (tagPtr == FindRowColTag(tablePtr, row, ROW)) ||
+ (tagPtr == FindRowColTag(tablePtr, col, COL)));
+ }
+ /*
+ * Because we may call FindRowColTag above, we can't use
+ * the resultPtr, but this is almost equivalent, and is SAFE
+ */
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result));
+ return TCL_OK;
+
+ case TAG_NAMES:
+ /*
+ * Print out the tag names in priority order
+ */
+ if (objc < 3 || objc > 4) {
+ Tcl_WrongNumArgs(interp, 3, objv, "?pattern?");
+ return TCL_ERROR;
+ }
+ tagname = (objc == 4) ? Tcl_GetString(objv[3]) : NULL;
+ for (i = 0; i < tablePtr->tagPrioSize; i++) {
+ keybuf = tablePtr->tagPrioNames[i];
+ if (objc == 3 || Tcl_StringMatch(keybuf, tagname)) {
+ objPtr = Tcl_NewStringObj(keybuf, -1);
+ Tcl_ListObjAppendElement(NULL, resultPtr, objPtr);
+ }
+ }
+ return TCL_OK;
+
+ case TAG_LOWER:
+ case TAG_RAISE:
+ /*
+ * Change priority of the named tag
+ */
+ if (objc != 4 && objc != 5) {
+ Tcl_WrongNumArgs(interp, 3, objv, (cmdIndex == TAG_LOWER) ?
+ "tagName ?belowThis?" : "tagName ?aboveThis?");
+ return TCL_ERROR;
+ }
+ tagname = Tcl_GetString(objv[3]);
+ /* check to see if the tag actually exists */
+ entryPtr = Tcl_FindHashEntry(tablePtr->tagTable, tagname);
+ if (entryPtr == NULL) {
+ goto invalidtag;
+ }
+ tagPtr = (TableTag *) Tcl_GetHashValue(entryPtr);
+ tagPrio = TableTagGetPriority(tablePtr, tagPtr);
+ keybuf = tablePtr->tagPrioNames[tagPrio];
+ /*
+ * In the RAISE case, the priority is one higher (-1) because
+ * we want the named tag to move above the other in priority.
+ */
+ if (objc == 5) {
+ tagname = Tcl_GetString(objv[4]);
+ entryPtr = Tcl_FindHashEntry(tablePtr->tagTable, tagname);
+ if (entryPtr == NULL) {
+ goto invalidtag;
+ }
+ tag2Ptr = (TableTag *) Tcl_GetHashValue(entryPtr);
+ if (cmdIndex == TAG_LOWER) {
+ value = TableTagGetPriority(tablePtr, tag2Ptr);
+ } else {
+ value = TableTagGetPriority(tablePtr, tag2Ptr) - 1;
+ }
+ } else {
+ if (cmdIndex == TAG_LOWER) {
+ /*
+ * Lower this tag's priority to the bottom.
+ */
+ value = tablePtr->tagPrioSize - 1;
+ } else {
+ /*
+ * Raise this tag's priority to the top.
+ */
+ value = -1;
+ }
+ }
+ if (value < tagPrio) {
+ /*
+ * Move tag up in priority.
+ */
+ for (i = tagPrio; i > value; i--) {
+ tablePtr->tagPrioNames[i] = tablePtr->tagPrioNames[i-1];
+ tablePtr->tagPrios[i] = tablePtr->tagPrios[i-1];
+ }
+ i++;
+ tablePtr->tagPrioNames[i] = keybuf;
+ tablePtr->tagPrios[i] = tagPtr;
+ refresh = 1;
+ } else if (value > tagPrio) {
+ /*
+ * Move tag down in priority.
+ */
+ for (i = tagPrio; i < value; i++) {
+ tablePtr->tagPrioNames[i] = tablePtr->tagPrioNames[i+1];
+ tablePtr->tagPrios[i] = tablePtr->tagPrios[i+1];
+ }
+ tablePtr->tagPrioNames[i] = keybuf;
+ tablePtr->tagPrios[i] = tagPtr;
+ refresh = 1;
+ }
+ /* since we deleted a tag, redraw the screen */
+ if (refresh) {
+ TableInvalidateAll(tablePtr, 0);
+ }
+ return TCL_OK;
+
+ }
+ return TCL_OK;
+
+ invalidtag:
+ /*
+ * When jumping here, ensure the invalid 'tagname' is set already.
+ */
+ Tcl_AppendStringsToObj(resultPtr, "invalid tag name \"",
+ tagname, "\"", (char *) NULL);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableOptionReliefSet --
+ *
+ * This routine configures the borderwidth value for a tag.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * It may adjust the tag struct values of relief[0..4] and borders.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TableOptionReliefSet(clientData, interp, tkwin, value, widgRec, offset)
+ ClientData clientData; /* Type of struct being set. */
+ Tcl_Interp *interp; /* Used for reporting errors. */
+ Tk_Window tkwin; /* Window containing table widget. */
+ CONST84 char *value; /* Value of option. */
+ char *widgRec; /* Pointer to record for item. */
+ int offset; /* Offset into item. */
+{
+ TableTag *tagPtr = (TableTag *) widgRec;
+
+ if (*value == '\0') {
+ tagPtr->relief = -1;
+ } else {
+ return Tk_GetRelief(interp, value, &(tagPtr->relief));
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableOptionReliefGet --
+ *
+ * Results:
+ * Value of the tag's -relief option.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static char *
+TableOptionReliefGet(clientData, tkwin, widgRec, offset, freeProcPtr)
+ ClientData clientData; /* Type of struct being set. */
+ Tk_Window tkwin; /* Window containing canvas widget. */
+ char *widgRec; /* Pointer to record for item. */
+ int offset; /* Offset into item. */
+ Tcl_FreeProc **freeProcPtr; /* Pointer to variable to fill in with
+ * information about how to reclaim
+ * storage for return string. */
+{
+ return (char *) Tk_NameOfRelief(((TableTag *) widgRec)->relief);
+}
diff --git a/tktable/generic/tkTableUtil.c b/tktable/generic/tkTableUtil.c
new file mode 100644
index 0000000..5e5e9d0
--- /dev/null
+++ b/tktable/generic/tkTableUtil.c
@@ -0,0 +1,372 @@
+/*
+ * tkTableUtil.c --
+ *
+ * This module contains utility functions for table widgets.
+ *
+ * Copyright (c) 2000-2002 Jeffrey Hobbs
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id: tkTableUtil.c,v 1.4 2002/10/16 07:31:48 hobbs Exp $
+ */
+
+#include "tkTable.h"
+
+static char * Cmd_GetName _ANSI_ARGS_((const Cmd_Struct *cmds, int val));
+static int Cmd_GetValue _ANSI_ARGS_((const Cmd_Struct *cmds,
+ const char *arg));
+static void Cmd_GetError _ANSI_ARGS_((Tcl_Interp *interp,
+ const Cmd_Struct *cmds, const char *arg));
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Table_ClearHashTable --
+ * This procedure is invoked to clear a STRING_KEY hash table,
+ * freeing the string entries and then deleting the hash table.
+ * The hash table cannot be used after calling this, except to
+ * be freed or reinitialized.
+ *
+ * Results:
+ * Cached info will be lost.
+ *
+ * Side effects:
+ * Can cause redraw.
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+void
+Table_ClearHashTable(Tcl_HashTable *hashTblPtr)
+{
+ Tcl_HashEntry *entryPtr;
+ Tcl_HashSearch search;
+ char *value;
+
+ for (entryPtr = Tcl_FirstHashEntry(hashTblPtr, &search);
+ entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&search)) {
+ value = (char *) Tcl_GetHashValue(entryPtr);
+ if (value != NULL) ckfree(value);
+ }
+
+ Tcl_DeleteHashTable(hashTblPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableOptionBdSet --
+ *
+ * This routine configures the borderwidth value for a tag.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * It may adjust the tag struct values of bd[0..4] and borders.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TableOptionBdSet(clientData, interp, tkwin, value, widgRec, offset)
+ ClientData clientData; /* Type of struct being set. */
+ Tcl_Interp *interp; /* Used for reporting errors. */
+ Tk_Window tkwin; /* Window containing table widget. */
+ CONST84 char *value; /* Value of option. */
+ char *widgRec; /* Pointer to record for item. */
+ int offset; /* Offset into item. */
+{
+ char **borderStr;
+ int *bordersPtr, *bdPtr;
+ int type = (int) clientData;
+ int result = TCL_OK;
+ int argc;
+ CONST84 char **argv;
+
+ if ((type == BD_TABLE) && (value[0] == '\0')) {
+ /*
+ * NULL strings aren't allowed for the table global -bd
+ */
+ Tcl_AppendResult(interp, "borderwidth value may not be empty",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if ((type == BD_TABLE) || (type == BD_TABLE_TAG)) {
+ TableTag *tagPtr = (TableTag *) (widgRec + offset);
+ borderStr = &(tagPtr->borderStr);
+ bordersPtr = &(tagPtr->borders);
+ bdPtr = tagPtr->bd;
+ } else if (type == BD_TABLE_WIN) {
+ TableEmbWindow *tagPtr = (TableEmbWindow *) widgRec;
+ borderStr = &(tagPtr->borderStr);
+ bordersPtr = &(tagPtr->borders);
+ bdPtr = tagPtr->bd;
+ } else {
+ panic("invalid type given to TableOptionBdSet\n");
+ return TCL_ERROR; /* lint */
+ }
+
+ result = Tcl_SplitList(interp, value, &argc, &argv);
+ if (result == TCL_OK) {
+ int i, bd[4];
+
+ if (((type == BD_TABLE) && (argc == 0)) || (argc == 3) || (argc > 4)) {
+ Tcl_AppendResult(interp,
+ "1, 2 or 4 values must be specified for borderwidth",
+ (char *) NULL);
+ result = TCL_ERROR;
+ } else {
+ /*
+ * We use the shadow bd array first, in case we have an error
+ * parsing arguments half way through.
+ */
+ for (i = 0; i < argc; i++) {
+ if (Tk_GetPixels(interp, tkwin, argv[i], &(bd[i])) != TCL_OK) {
+ result = TCL_ERROR;
+ break;
+ }
+ }
+ /*
+ * If everything is OK, store the parsed and given values for
+ * easy retrieval.
+ */
+ if (result == TCL_OK) {
+ for (i = 0; i < argc; i++) {
+ bdPtr[i] = MAX(0, bd[i]);
+ }
+ if (*borderStr) {
+ ckfree(*borderStr);
+ }
+ if (value) {
+ *borderStr = (char *) ckalloc(strlen(value) + 1);
+ strcpy(*borderStr, value);
+ } else {
+ *borderStr = NULL;
+ }
+ *bordersPtr = argc;
+ }
+ }
+ ckfree ((char *) argv);
+ }
+
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableOptionBdGet --
+ *
+ * Results:
+ * Value of the -bd option.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+TableOptionBdGet(clientData, tkwin, widgRec, offset, freeProcPtr)
+ ClientData clientData; /* Type of struct being set. */
+ Tk_Window tkwin; /* Window containing canvas widget. */
+ char *widgRec; /* Pointer to record for item. */
+ int offset; /* Offset into item. */
+ Tcl_FreeProc **freeProcPtr; /* Pointer to variable to fill in with
+ * information about how to reclaim
+ * storage for return string. */
+{
+ register int type = (int) clientData;
+
+ if (type == BD_TABLE) {
+ return ((TableTag *) (widgRec + offset))->borderStr;
+ } else if (type == BD_TABLE_TAG) {
+ return ((TableTag *) widgRec)->borderStr;
+ } else if (type == BD_TABLE_WIN) {
+ return ((TableEmbWindow *) widgRec)->borderStr;
+ } else {
+ panic("invalid type given to TableOptionBdSet\n");
+ return NULL; /* lint */
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableTagConfigureBd --
+ * This routine configures the border values based on a tag.
+ * The previous value of the bd string (oldValue) is assumed to
+ * be a valid value for this tag.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * It may adjust the value used by -bd.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TableTagConfigureBd(Table *tablePtr, TableTag *tagPtr,
+ char *oldValue, int nullOK)
+{
+ int i, argc, result = TCL_OK;
+ CONST84 char **argv;
+
+ /*
+ * First check to see if the value really changed.
+ */
+ if (strcmp(tagPtr->borderStr ? tagPtr->borderStr : "",
+ oldValue ? oldValue : "") == 0) {
+ return TCL_OK;
+ }
+
+ tagPtr->borders = 0;
+ if (!nullOK && ((tagPtr->borderStr == NULL)
+ || (*(tagPtr->borderStr) == '\0'))) {
+ /*
+ * NULL strings aren't allowed for this tag
+ */
+ result = TCL_ERROR;
+ } else if (tagPtr->borderStr) {
+ result = Tcl_SplitList(tablePtr->interp, tagPtr->borderStr,
+ &argc, &argv);
+ if (result == TCL_OK) {
+ if ((!nullOK && (argc == 0)) || (argc == 3) || (argc > 4)) {
+ Tcl_SetResult(tablePtr->interp,
+ "1, 2 or 4 values must be specified to -borderwidth",
+ TCL_STATIC);
+ result = TCL_ERROR;
+ } else {
+ for (i = 0; i < argc; i++) {
+ if (Tk_GetPixels(tablePtr->interp, tablePtr->tkwin,
+ argv[i], &(tagPtr->bd[i])) != TCL_OK) {
+ result = TCL_ERROR;
+ break;
+ }
+ tagPtr->bd[i] = MAX(0, tagPtr->bd[i]);
+ }
+ tagPtr->borders = argc;
+ }
+ ckfree ((char *) argv);
+ }
+ }
+
+ if (result != TCL_OK) {
+ if (tagPtr->borderStr) {
+ ckfree ((char *) tagPtr->borderStr);
+ }
+ if (oldValue != NULL) {
+ size_t length = strlen(oldValue) + 1;
+ /*
+ * We are making the assumption that oldValue is correct.
+ * We have to reparse in case the bad new value had a couple
+ * of correct args before failing on a bad pixel value.
+ */
+ Tcl_SplitList(tablePtr->interp, oldValue, &argc, &argv);
+ for (i = 0; i < argc; i++) {
+ Tk_GetPixels(tablePtr->interp, tablePtr->tkwin,
+ argv[i], &(tagPtr->bd[i]));
+ }
+ ckfree ((char *) argv);
+ tagPtr->borders = argc;
+ tagPtr->borderStr = (char *) ckalloc(length);
+ memcpy(tagPtr->borderStr, oldValue, length);
+ } else {
+ tagPtr->borders = 0;
+ tagPtr->borderStr = (char *) NULL;
+ }
+ }
+
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Cmd_OptionSet --
+ *
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Cmd_OptionSet(ClientData clientData, Tcl_Interp *interp,
+ Tk_Window unused, CONST84 char *value, char *widgRec, int offset)
+{
+ Cmd_Struct *p = (Cmd_Struct *)clientData;
+ int mode = Cmd_GetValue(p,value);
+ if (!mode) {
+ Cmd_GetError(interp,p,value);
+ return TCL_ERROR;
+ }
+ *((int*)(widgRec+offset)) = mode;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Cmd_OptionGet --
+ *
+ *
+ * Results:
+ * Value of the option.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Cmd_OptionGet(ClientData clientData, Tk_Window unused,
+ char *widgRec, int offset, Tcl_FreeProc **freeProcPtr)
+{
+ Cmd_Struct *p = (Cmd_Struct *)clientData;
+ int mode = *((int*)(widgRec+offset));
+ return Cmd_GetName(p,mode);
+}
+
+/*
+ * simple Cmd_Struct lookup functions
+ */
+
+char *
+Cmd_GetName(const Cmd_Struct *cmds, int val)
+{
+ for(;cmds->name && cmds->name[0];cmds++) {
+ if (cmds->value==val) return cmds->name;
+ }
+ return NULL;
+}
+
+int
+Cmd_GetValue(const Cmd_Struct *cmds, const char *arg)
+{
+ unsigned int len = strlen(arg);
+ for(;cmds->name && cmds->name[0];cmds++) {
+ if (!strncmp(cmds->name, arg, len)) return cmds->value;
+ }
+ return 0;
+}
+
+void
+Cmd_GetError(Tcl_Interp *interp, const Cmd_Struct *cmds, const char *arg)
+{
+ int i;
+ Tcl_AppendResult(interp, "bad option \"", arg, "\" must be ", (char *) 0);
+ for(i=0;cmds->name && cmds->name[0];cmds++,i++) {
+ Tcl_AppendResult(interp, (i?", ":""), cmds->name, (char *) 0);
+ }
+}
diff --git a/tktable/generic/tkTableWin.c b/tktable/generic/tkTableWin.c
new file mode 100644
index 0000000..86e1c0c
--- /dev/null
+++ b/tktable/generic/tkTableWin.c
@@ -0,0 +1,955 @@
+/*
+ * tkTableWin.c --
+ *
+ * This module implements embedded windows for table widgets.
+ * Much of this code is adapted from tkGrid.c and tkTextWind.c.
+ *
+ * Copyright (c) 1998-2002 Jeffrey Hobbs
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id: tkTableWin.c,v 1.6 2004/06/11 00:24:44 hobbs Exp $
+ */
+
+#include "tkTable.h"
+
+static int StickyParseProc _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, Tk_Window tkwin,
+ CONST84 char *value, char *widgRec, int offset));
+static char * StickyPrintProc _ANSI_ARGS_((ClientData clientData,
+ Tk_Window tkwin, char *widgRec, int offset,
+ Tcl_FreeProc **freeProcPtr));
+
+static void EmbWinLostSlaveProc _ANSI_ARGS_((ClientData clientData,
+ Tk_Window tkwin));
+static void EmbWinRequestProc _ANSI_ARGS_((ClientData clientData,
+ Tk_Window tkwin));
+
+static void EmbWinCleanup _ANSI_ARGS_((Table *tablePtr,
+ TableEmbWindow *ewPtr));
+static int EmbWinConfigure _ANSI_ARGS_((Table *tablePtr,
+ TableEmbWindow *ewPtr,
+ int objc, Tcl_Obj *CONST objv[]));
+static void EmbWinStructureProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static void EmbWinUnmapNow _ANSI_ARGS_((Tk_Window ewTkwin,
+ Tk_Window tkwin));
+
+static Tk_GeomMgr tableGeomType = {
+ "table", /* name */
+ EmbWinRequestProc, /* requestProc */
+ EmbWinLostSlaveProc, /* lostSlaveProc */
+};
+
+/* windows subcommands */
+static CONST84 char *winCmdNames[] = {
+ "cget", "configure", "delete", "move", "names", (char *) NULL
+};
+enum winCommand {
+ WIN_CGET, WIN_CONFIGURE, WIN_DELETE, WIN_MOVE, WIN_NAMES
+};
+
+/* Flag values for "sticky"ness The 16 combinations subsume the packer's
+ * notion of anchor and fill.
+ *
+ * STICK_NORTH This window sticks to the top of its cavity.
+ * STICK_EAST This window sticks to the right edge of its cavity.
+ * STICK_SOUTH This window sticks to the bottom of its cavity.
+ * STICK_WEST This window sticks to the left edge of its cavity.
+ */
+
+#define STICK_NORTH (1<<0)
+#define STICK_EAST (1<<1)
+#define STICK_SOUTH (1<<2)
+#define STICK_WEST (1<<3)
+
+/*
+ * The default specification for configuring embedded windows
+ * Done like this to make the command line parsing easy
+ */
+
+static Tk_CustomOption stickyOption = { StickyParseProc, StickyPrintProc,
+ (ClientData) NULL };
+static Tk_CustomOption tagBdOpt = { TableOptionBdSet, TableOptionBdGet,
+ (ClientData) BD_TABLE_WIN };
+
+static Tk_ConfigSpec winConfigSpecs[] = {
+ {TK_CONFIG_BORDER, "-background", "background", "Background", NULL,
+ Tk_Offset(TableEmbWindow, bg),
+ TK_CONFIG_DONT_SET_DEFAULT|TK_CONFIG_NULL_OK },
+ {TK_CONFIG_SYNONYM, "-bd", "borderWidth", (char *)NULL, (char *)NULL, 0, 0},
+ {TK_CONFIG_SYNONYM, "-bg", "background", (char *)NULL, (char *)NULL, 0, 0},
+ {TK_CONFIG_CUSTOM, "-borderwidth", "borderWidth", "BorderWidth", "",
+ 0 /* no offset */,
+ TK_CONFIG_DONT_SET_DEFAULT|TK_CONFIG_NULL_OK, &tagBdOpt },
+ {TK_CONFIG_STRING, "-create", (char *)NULL, (char *)NULL, (char *)NULL,
+ Tk_Offset(TableEmbWindow, create),
+ TK_CONFIG_DONT_SET_DEFAULT|TK_CONFIG_NULL_OK },
+ {TK_CONFIG_PIXELS, "-padx", (char *)NULL, (char *)NULL, (char *)NULL,
+ Tk_Offset(TableEmbWindow, padX), TK_CONFIG_DONT_SET_DEFAULT },
+ {TK_CONFIG_PIXELS, "-pady", (char *)NULL, (char *)NULL, (char *)NULL,
+ Tk_Offset(TableEmbWindow, padY), TK_CONFIG_DONT_SET_DEFAULT },
+ {TK_CONFIG_CUSTOM, "-sticky", (char *)NULL, (char *)NULL, (char *)NULL,
+ Tk_Offset(TableEmbWindow, sticky), TK_CONFIG_DONT_SET_DEFAULT,
+ &stickyOption},
+ {TK_CONFIG_RELIEF, "-relief", "relief", "Relief", NULL,
+ Tk_Offset(TableEmbWindow, relief), 0 },
+ {TK_CONFIG_WINDOW, "-window", (char *)NULL, (char *)NULL, (char *)NULL,
+ Tk_Offset(TableEmbWindow, tkwin),
+ TK_CONFIG_DONT_SET_DEFAULT|TK_CONFIG_NULL_OK },
+ {TK_CONFIG_END, (char *)NULL, (char *)NULL, (char *)NULL,
+ (char *)NULL, 0, 0 }
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StickyPrintProc --
+ * Converts the internal boolean combination of "sticky" bits onto
+ * a TCL string element containing zero or more of n, s, e, or w.
+ *
+ * Results:
+ * A string is placed into the "result" pointer.
+ *
+ * Side effects:
+ * none.
+ *
+ *----------------------------------------------------------------------
+ */
+static char *
+StickyPrintProc(clientData, tkwin, widgRec, offset, freeProcPtr)
+ ClientData clientData; /* Ignored. */
+ Tk_Window tkwin; /* Window for text widget. */
+ char *widgRec; /* Pointer to TkTextEmbWindow
+ * structure. */
+ int offset; /* Ignored. */
+ Tcl_FreeProc **freeProcPtr; /* Pointer to variable to fill in with
+ * information about how to reclaim
+ * storage for return string. */
+{
+ int flags = ((TableEmbWindow *) widgRec)->sticky;
+ int count = 0;
+ char *result = (char *) ckalloc(5*sizeof(char));
+
+ if (flags&STICK_NORTH) result[count++] = 'n';
+ if (flags&STICK_EAST) result[count++] = 'e';
+ if (flags&STICK_SOUTH) result[count++] = 's';
+ if (flags&STICK_WEST) result[count++] = 'w';
+
+ *freeProcPtr = TCL_DYNAMIC;
+ result[count] = '\0';
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringParseProc --
+ * Converts an ascii string representing a widgets stickyness
+ * into the boolean result.
+ *
+ * Results:
+ * The boolean combination of the "sticky" bits is retuned. If an
+ * error occurs, such as an invalid character, -1 is returned instead.
+ *
+ * Side effects:
+ * none
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+StickyParseProc(clientData, interp, tkwin, value, widgRec, offset)
+ ClientData clientData; /* Not used.*/
+ Tcl_Interp *interp; /* Used for reporting errors. */
+ Tk_Window tkwin; /* Window for text widget. */
+ CONST84 char *value; /* Value of option. */
+ char *widgRec; /* Pointer to TkTextEmbWindow
+ * structure. */
+ int offset; /* Offset into item (ignored). */
+{
+ register TableEmbWindow *ewPtr = (TableEmbWindow *) widgRec;
+ int sticky = 0;
+ char c;
+
+ while ((c = *value++) != '\0') {
+ switch (c) {
+ case 'n': case 'N': sticky |= STICK_NORTH; break;
+ case 'e': case 'E': sticky |= STICK_EAST; break;
+ case 's': case 'S': sticky |= STICK_SOUTH; break;
+ case 'w': case 'W': sticky |= STICK_WEST; break;
+ case ' ': case ',': case '\t': case '\r': case '\n': break;
+ default:
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "bad sticky value \"", --value,
+ "\": must contain n, s, e or w",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+ ewPtr->sticky = sticky;
+ return TCL_OK;
+}
+
+/*
+ * ckallocs space for a new embedded window structure and clears the structure
+ * returns the pointer to the new structure
+ */
+static TableEmbWindow *
+TableNewEmbWindow(Table *tablePtr)
+{
+ TableEmbWindow *ewPtr = (TableEmbWindow *) ckalloc(sizeof(TableEmbWindow));
+ memset((VOID *) ewPtr, 0, sizeof(TableEmbWindow));
+
+ /*
+ * Set the values that aren't 0/NULL by default
+ */
+ ewPtr->tablePtr = tablePtr;
+ ewPtr->relief = -1;
+ ewPtr->padX = -1;
+ ewPtr->padY = -1;
+
+ return ewPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EmbWinCleanup --
+ * Releases resources used by an embedded window before it is freed up.
+ *
+ * Results:
+ * Window will no longer be valid.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+EmbWinCleanup(Table *tablePtr, TableEmbWindow *ewPtr)
+{
+ Tk_FreeOptions(winConfigSpecs, (char *) ewPtr, tablePtr->display, 0);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbWinDisplay --
+ *
+ * This procedure is invoked by TableDisplay for
+ * mapping windows into cells.
+ *
+ * Results:
+ * Displays or moves window on table screen.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+void
+EmbWinDisplay(Table *tablePtr, Drawable window, TableEmbWindow *ewPtr,
+ TableTag *tagPtr, int x, int y, int width, int height)
+{
+ Tk_Window tkwin = tablePtr->tkwin;
+ Tk_Window ewTkwin = ewPtr->tkwin;
+ int diffx=0; /* Cavity width - slave width. */
+ int diffy=0; /* Cavity hight - slave height. */
+ int sticky = ewPtr->sticky;
+ int padx, pady;
+
+ if (ewPtr->bg) tagPtr->bg = ewPtr->bg;
+ if (ewPtr->relief != -1) tagPtr->relief = ewPtr->relief;
+ if (ewPtr->borders) {
+ tagPtr->borderStr = ewPtr->borderStr;
+ tagPtr->borders = ewPtr->borders;
+ tagPtr->bd[0] = ewPtr->bd[0];
+ tagPtr->bd[1] = ewPtr->bd[1];
+ tagPtr->bd[2] = ewPtr->bd[2];
+ tagPtr->bd[3] = ewPtr->bd[3];
+ }
+
+ padx = (ewPtr->padX < 0) ? tablePtr->padX : ewPtr->padX;
+ pady = (ewPtr->padY < 0) ? tablePtr->padY : ewPtr->padY;
+
+ x += padx;
+ width -= padx*2;
+ y += pady;
+ height -= pady*2;
+
+ if (width > Tk_ReqWidth(ewPtr->tkwin)) {
+ diffx = width - Tk_ReqWidth(ewPtr->tkwin);
+ width = Tk_ReqWidth(ewPtr->tkwin);
+ }
+ if (height > Tk_ReqHeight(ewPtr->tkwin)) {
+ diffy = height - Tk_ReqHeight(ewPtr->tkwin);
+ height = Tk_ReqHeight(ewPtr->tkwin);
+ }
+ if (sticky&STICK_EAST && sticky&STICK_WEST) {
+ width += diffx;
+ }
+ if (sticky&STICK_NORTH && sticky&STICK_SOUTH) {
+ height += diffy;
+ }
+ if (!(sticky&STICK_WEST)) {
+ x += (sticky&STICK_EAST) ? diffx : diffx/2;
+ }
+ if (!(sticky&STICK_NORTH)) {
+ y += (sticky&STICK_SOUTH) ? diffy : diffy/2;
+ }
+
+ /*
+ * If we fall below a specific minimum width/height requirement,
+ * we just unmap the window
+ */
+ if (width < 2 || height < 2) {
+ if (ewPtr->displayed) {
+ EmbWinUnmapNow(ewTkwin, tkwin);
+ }
+ return;
+ }
+
+ if (tkwin == Tk_Parent(ewTkwin)) {
+ if ((x != Tk_X(ewTkwin)) || (y != Tk_Y(ewTkwin))
+ || (width != Tk_Width(ewTkwin))
+ || (height != Tk_Height(ewTkwin))) {
+ Tk_MoveResizeWindow(ewTkwin, x, y, width, height);
+ }
+ Tk_MapWindow(ewTkwin);
+ } else {
+ Tk_MaintainGeometry(ewTkwin, tkwin, x, y, width, height);
+ }
+ ewPtr->displayed = 1;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbWinUnmapNow --
+ * Handles unmapping the window depending on parent.
+ * tkwin should be tablePtr->tkwin.
+ * ewTkwin should be ewPtr->tkwin.
+ *
+ * Results:
+ * Removes the window.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+static void
+EmbWinUnmapNow(Tk_Window ewTkwin, Tk_Window tkwin)
+{
+ if (tkwin != Tk_Parent(ewTkwin)) {
+ Tk_UnmaintainGeometry(ewTkwin, tkwin);
+ }
+ Tk_UnmapWindow(ewTkwin);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbWinUnmap --
+ * This procedure is invoked by TableAdjustParams for
+ * unmapping windows managed moved offscreen.
+ * rlo, ... should be in real coords.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Unmaps embedded windows.
+ *
+ *--------------------------------------------------------------
+ */
+void
+EmbWinUnmap(Table *tablePtr, int rlo, int rhi, int clo, int chi)
+{
+ register TableEmbWindow *ewPtr;
+ Tcl_HashEntry *entryPtr;
+ int row, col, trow, tcol;
+ char buf[INDEX_BUFSIZE];
+
+ /*
+ * Transform numbers from real to user user coords
+ */
+ rlo += tablePtr->rowOffset;
+ rhi += tablePtr->rowOffset;
+ clo += tablePtr->colOffset;
+ chi += tablePtr->colOffset;
+ for (row = rlo; row <= rhi; row++) {
+ for (col = clo; col <= chi; col++) {
+ TableTrueCell(tablePtr, row, col, &trow, &tcol);
+ TableMakeArrayIndex(trow, tcol, buf);
+ entryPtr = Tcl_FindHashEntry(tablePtr->winTable, buf);
+ if (entryPtr != NULL) {
+ ewPtr = (TableEmbWindow *) Tcl_GetHashValue(entryPtr);
+ if (ewPtr->displayed) {
+ ewPtr->displayed = 0;
+ if (ewPtr->tkwin != NULL && tablePtr->tkwin != NULL) {
+ EmbWinUnmapNow(ewPtr->tkwin, tablePtr->tkwin);
+ }
+ }
+ }
+ }
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbWinRequestProc --
+ * This procedure is invoked by Tk_GeometryRequest for
+ * windows managed by the Table.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Arranges for tkwin, and all its managed siblings, to
+ * be re-arranged at the next idle point.
+ *
+ *--------------------------------------------------------------
+ */
+static void
+EmbWinRequestProc(clientData, tkwin)
+ ClientData clientData; /* Table's information about
+ * window that got new preferred
+ * geometry. */
+ Tk_Window tkwin; /* Other Tk-related information
+ * about the window. */
+{
+ register TableEmbWindow *ewPtr = (TableEmbWindow *) clientData;
+
+ /*
+ * Resize depends on the sticky
+ */
+ if (ewPtr->displayed && ewPtr->hPtr != NULL) {
+ Table *tablePtr = ewPtr->tablePtr;
+ int row, col, x, y, width, height;
+
+ TableParseArrayIndex(&row, &col,
+ Tcl_GetHashKey(tablePtr->winTable, ewPtr->hPtr));
+ if (TableCellVCoords(tablePtr, row-tablePtr->rowOffset,
+ col-tablePtr->colOffset, &x, &y, &width, &height,
+ 0)) {
+ TableInvalidate(tablePtr, x, y, width, height, 0);
+ }
+ }
+}
+
+static void
+EmbWinRemove(TableEmbWindow *ewPtr)
+{
+ Table *tablePtr = ewPtr->tablePtr;
+
+ if (ewPtr->tkwin != NULL) {
+ Tk_DeleteEventHandler(ewPtr->tkwin, StructureNotifyMask,
+ EmbWinStructureProc, (ClientData) ewPtr);
+ ewPtr->tkwin = NULL;
+ }
+ ewPtr->displayed = 0;
+ if (tablePtr->tkwin != NULL) {
+ int row, col, x, y, width, height;
+
+ TableParseArrayIndex(&row, &col,
+ Tcl_GetHashKey(tablePtr->winTable, ewPtr->hPtr));
+ /* this will cause windows removed from the table to actually
+ * cause the associated embdedded window hash data to be removed */
+ Tcl_DeleteHashEntry(ewPtr->hPtr);
+ if (TableCellVCoords(tablePtr, row-tablePtr->rowOffset,
+ col-tablePtr->colOffset, &x, &y, &width, &height,
+ 0))
+ TableInvalidate(tablePtr, x, y, width, height, 1);
+ }
+ /* this will cause windows removed from the table to actually
+ * cause the associated embdedded window hash data to be removed */
+ EmbWinCleanup(tablePtr, ewPtr);
+ ckfree((char *) ewPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbWinLostSlaveProc --
+ * This procedure is invoked by Tk whenever some other geometry
+ * claims control over a slave that used to be managed by us.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Forgets all table-related information about the slave.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+EmbWinLostSlaveProc(clientData, tkwin)
+ ClientData clientData; /* Table structure for slave window that
+ * was stolen away. */
+ Tk_Window tkwin; /* Tk's handle for the slave window. */
+{
+ register TableEmbWindow *ewPtr = (TableEmbWindow *) clientData;
+
+#if 0
+ Tcl_CancelIdleCall(EmbWinDelayedUnmap, (ClientData) ewPtr);
+#endif
+ EmbWinUnmapNow(tkwin, ewPtr->tablePtr->tkwin);
+ EmbWinRemove(ewPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbWinStructureProc --
+ * This procedure is invoked by the Tk event loop whenever
+ * StructureNotify events occur for a window that's embedded
+ * in a table widget. This procedure's only purpose is to
+ * clean up when windows are deleted.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The window is disassociated from the window segment, and
+ * the portion of the table is redisplayed.
+ *
+ *--------------------------------------------------------------
+ */
+static void
+EmbWinStructureProc(clientData, eventPtr)
+ ClientData clientData; /* Pointer to record describing window item. */
+ XEvent *eventPtr; /* Describes what just happened. */
+{
+ register TableEmbWindow *ewPtr = (TableEmbWindow *) clientData;
+
+ if (eventPtr->type != DestroyNotify) {
+ return;
+ }
+
+ EmbWinRemove(ewPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbWinDelete --
+ * This procedure is invoked by ... whenever
+ * an embedded window is being deleted.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The embedded window is deleted, if it exists, and any resources
+ * associated with it are released.
+ *
+ *--------------------------------------------------------------
+ */
+void
+EmbWinDelete(register Table *tablePtr, TableEmbWindow *ewPtr)
+{
+ Tcl_HashEntry *entryPtr = ewPtr->hPtr;
+
+ if (ewPtr->tkwin != NULL) {
+ Tk_Window tkwin = ewPtr->tkwin;
+ /*
+ * Delete the event handler for the window before destroying
+ * the window, so that EmbWinStructureProc doesn't get called
+ * (we'll already do everything that it would have done, and
+ * it will just get confused).
+ */
+
+ ewPtr->tkwin = NULL;
+ Tk_DeleteEventHandler(tkwin, StructureNotifyMask,
+ EmbWinStructureProc, (ClientData) ewPtr);
+ Tk_DestroyWindow(tkwin);
+ }
+ if (tablePtr->tkwin != NULL && entryPtr != NULL) {
+ int row, col, x, y, width, height;
+ TableParseArrayIndex(&row, &col,
+ Tcl_GetHashKey(tablePtr->winTable, entryPtr));
+ Tcl_DeleteHashEntry(entryPtr);
+
+ if (TableCellVCoords(tablePtr, row-tablePtr->rowOffset,
+ col-tablePtr->colOffset,
+ &x, &y, &width, &height, 0))
+ TableInvalidate(tablePtr, x, y, width, height, 0);
+ }
+#if 0
+ Tcl_CancelIdleCall(EmbWinDelayedUnmap, (ClientData) ewPtr);
+#endif
+ EmbWinCleanup(tablePtr, ewPtr);
+ ckfree((char *) ewPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbWinConfigure --
+ * This procedure is called to handle configuration options
+ * for an embedded window.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If TCL_ERROR is
+ * returned, then the interp's result contains an error message..
+ *
+ * Side effects:
+ * Configuration information for the embedded window changes,
+ * such as alignment, stretching, or name of the embedded
+ * window.
+ *
+ *--------------------------------------------------------------
+ */
+static int
+EmbWinConfigure(tablePtr, ewPtr, objc, objv)
+ Table *tablePtr; /* Information about table widget that
+ * contains embedded window. */
+ TableEmbWindow *ewPtr; /* Embedded window to be configured. */
+ int objc; /* Number of objs in objv. */
+ Tcl_Obj *CONST objv[]; /* Obj type options. */
+{
+ Tcl_Interp *interp = tablePtr->interp;
+ Tk_Window oldWindow;
+ int i, result;
+ CONST84 char **argv;
+
+ oldWindow = ewPtr->tkwin;
+
+ /* Stringify */
+ argv = (CONST84 char **) ckalloc((objc + 1) * sizeof(char *));
+ for (i = 0; i < objc; i++)
+ argv[i] = Tcl_GetString(objv[i]);
+ argv[i] = NULL;
+ result = Tk_ConfigureWidget(interp, tablePtr->tkwin,
+ winConfigSpecs, objc, argv, (char *) ewPtr,
+ TK_CONFIG_ARGV_ONLY);
+ ckfree((char *) argv);
+ if (result != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (oldWindow != ewPtr->tkwin) {
+ ewPtr->displayed = 0;
+ if (oldWindow != NULL) {
+ Tk_DeleteEventHandler(oldWindow, StructureNotifyMask,
+ EmbWinStructureProc, (ClientData) ewPtr);
+ Tk_ManageGeometry(oldWindow, (Tk_GeomMgr *) NULL,
+ (ClientData) NULL);
+ EmbWinUnmapNow(oldWindow, tablePtr->tkwin);
+ }
+ if (ewPtr->tkwin != NULL) {
+ Tk_Window ancestor, parent;
+
+ /*
+ * Make sure that the table is either the parent of the
+ * embedded window or a descendant of that parent. Also,
+ * don't allow a top-level window to be managed inside
+ * a table.
+ */
+
+ parent = Tk_Parent(ewPtr->tkwin);
+ for (ancestor = tablePtr->tkwin; ;
+ ancestor = Tk_Parent(ancestor)) {
+ if (ancestor == parent) {
+ break;
+ }
+ if (Tk_IsTopLevel(ancestor)) {
+ badMaster:
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "can't embed ",
+ Tk_PathName(ewPtr->tkwin), " in ",
+ Tk_PathName(tablePtr->tkwin),
+ (char *)NULL);
+ ewPtr->tkwin = NULL;
+ return TCL_ERROR;
+ }
+ }
+ if (Tk_IsTopLevel(ewPtr->tkwin) ||
+ (ewPtr->tkwin == tablePtr->tkwin)) {
+ goto badMaster;
+ }
+
+ /*
+ * Take over geometry management for the window, plus create
+ * an event handler to find out when it is deleted.
+ */
+
+ Tk_ManageGeometry(ewPtr->tkwin, &tableGeomType, (ClientData)ewPtr);
+ Tk_CreateEventHandler(ewPtr->tkwin, StructureNotifyMask,
+ EmbWinStructureProc, (ClientData) ewPtr);
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Table_WinMove --
+ * This procedure is invoked by ... whenever
+ * an embedded window is being moved.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * If an embedded window is in the dest cell, it is deleted.
+ *
+ *--------------------------------------------------------------
+ */
+int
+Table_WinMove(register Table *tablePtr, char *CONST srcPtr,
+ char *CONST destPtr, int flags)
+{
+ int srow, scol, row, col, new;
+ Tcl_HashEntry *entryPtr;
+ TableEmbWindow *ewPtr;
+
+ if (TableGetIndex(tablePtr, srcPtr, &srow, &scol) != TCL_OK ||
+ TableGetIndex(tablePtr, destPtr, &row, &col) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ entryPtr = Tcl_FindHashEntry(tablePtr->winTable, srcPtr);
+ if (entryPtr == NULL) {
+ if (flags & INV_NO_ERR_MSG) {
+ return TCL_OK;
+ } else {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(tablePtr->interp),
+ "no window at index \"", srcPtr, "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+ /* avoid moving it to the same location */
+ if (srow == row && scol == col) {
+ return TCL_OK;
+ }
+ /* get the window pointer */
+ ewPtr = (TableEmbWindow *) Tcl_GetHashValue(entryPtr);
+ /* and free the old hash table entry */
+ Tcl_DeleteHashEntry(entryPtr);
+
+ entryPtr = Tcl_CreateHashEntry(tablePtr->winTable, destPtr, &new);
+ if (!new) {
+ /* window already there - just delete it */
+ TableEmbWindow *ewPtrDel;
+ ewPtrDel = (TableEmbWindow *) Tcl_GetHashValue(entryPtr);
+ /* This prevents the deletion of it's own entry, since we need it */
+ ewPtrDel->hPtr = NULL;
+ EmbWinDelete(tablePtr, ewPtrDel);
+ }
+ /* set the new entry's value */
+ Tcl_SetHashValue(entryPtr, (ClientData) ewPtr);
+ ewPtr->hPtr = entryPtr;
+
+ if (flags & INV_FORCE) {
+ int x, y, w, h;
+ /* Invalidate old cell */
+ if (TableCellVCoords(tablePtr, srow-tablePtr->rowOffset,
+ scol-tablePtr->colOffset, &x, &y, &w, &h, 0)) {
+ TableInvalidate(tablePtr, x, y, w, h, 0);
+ }
+ /* Invalidate new cell */
+ if (TableCellVCoords(tablePtr, row-tablePtr->rowOffset,
+ col-tablePtr->colOffset, &x, &y, &w, &h, 0)) {
+ TableInvalidate(tablePtr, x, y, w, h, 0);
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Table_WinDelete --
+ * This procedure is invoked by ... whenever
+ * an embedded window is being delete.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * Window info will be deleted.
+ *
+ *--------------------------------------------------------------
+ */
+int
+Table_WinDelete(register Table *tablePtr, char *CONST idxPtr)
+{
+ Tcl_HashEntry *entryPtr;
+
+ entryPtr = Tcl_FindHashEntry(tablePtr->winTable, idxPtr);
+ if (entryPtr != NULL) {
+ /* get the window pointer & clean up data associated with it */
+ EmbWinDelete(tablePtr, (TableEmbWindow *) Tcl_GetHashValue(entryPtr));
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Table_WindowCmd --
+ * This procedure is invoked to process the window method
+ * that corresponds to a widget managed by this module.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+int
+Table_WindowCmd(ClientData clientData, register Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[])
+{
+ register Table *tablePtr = (Table *)clientData;
+ int result = TCL_OK, cmdIndex, row, col, x, y, width, height, i, new;
+ TableEmbWindow *ewPtr;
+ Tcl_HashEntry *entryPtr;
+ Tcl_HashSearch search;
+ char buf[INDEX_BUFSIZE], *keybuf, *winname;
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "option ?arg arg ...?");
+ return TCL_ERROR;
+ }
+
+ /* parse the next argument */
+ if (Tcl_GetIndexFromObj(interp, objv[2], winCmdNames,
+ "option", 0, &cmdIndex) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ switch ((enum winCommand) cmdIndex) {
+ case WIN_CGET:
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 3, objv, "index option");
+ return TCL_ERROR;
+ }
+ entryPtr = Tcl_FindHashEntry(tablePtr->winTable,
+ Tcl_GetString(objv[3]));
+ if (entryPtr == NULL) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "no window at index \"",
+ Tcl_GetString(objv[3]), "\"", (char *)NULL);
+ return TCL_ERROR;
+ } else {
+ ewPtr = (TableEmbWindow *) Tcl_GetHashValue(entryPtr);
+ result = Tk_ConfigureValue(interp, tablePtr->tkwin, winConfigSpecs,
+ (char *) ewPtr,
+ Tcl_GetString(objv[4]), 0);
+ }
+ return result; /* CGET */
+
+ case WIN_CONFIGURE:
+ if (objc < 4) {
+ Tcl_WrongNumArgs(interp, 3, objv, "index ?arg arg ...?");
+ return TCL_ERROR;
+ }
+ if (TableGetIndexObj(tablePtr, objv[3], &row, &col) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ TableMakeArrayIndex(row, col, buf);
+ entryPtr = Tcl_CreateHashEntry(tablePtr->winTable, buf, &new);
+
+ if (new) {
+ /* create the structure */
+ ewPtr = TableNewEmbWindow(tablePtr);
+
+ /* insert it into the table */
+ Tcl_SetHashValue(entryPtr, (ClientData) ewPtr);
+ ewPtr->hPtr = entryPtr;
+
+ /* configure the window structure */
+ result = EmbWinConfigure(tablePtr, ewPtr, objc-4, objv+4);
+ if (result == TCL_ERROR) {
+ /* release the structure */
+ EmbWinCleanup(tablePtr, ewPtr);
+ ckfree((char *) ewPtr);
+
+ /* and free the hash table entry */
+ Tcl_DeleteHashEntry(entryPtr);
+ }
+ } else {
+ /* window exists, do a reconfig if we have enough args */
+ /* get the window pointer from the table */
+ ewPtr = (TableEmbWindow *) Tcl_GetHashValue(entryPtr);
+
+ /* 5 args means that there are values to replace */
+ if (objc > 5) {
+ /* and do a reconfigure */
+ result = EmbWinConfigure(tablePtr, ewPtr, objc-4, objv+4);
+ }
+ }
+ if (result == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * If there were less than 6 args, we need
+ * to do a printout of the config, even for new windows
+ */
+ if (objc < 6) {
+ result = Tk_ConfigureInfo(interp, tablePtr->tkwin, winConfigSpecs,
+ (char *) ewPtr, (objc == 5)?
+ Tcl_GetString(objv[4]) : NULL, 0);
+ } else {
+ /* Otherwise we reconfigured so invalidate
+ * the table for a redraw */
+ if (TableCellVCoords(tablePtr, row-tablePtr->rowOffset,
+ col-tablePtr->colOffset,
+ &x, &y, &width, &height, 0)) {
+ TableInvalidate(tablePtr, x, y, width, height, 1);
+ }
+ }
+ return result; /* CONFIGURE */
+
+ case WIN_DELETE:
+ if (objc < 4) {
+ Tcl_WrongNumArgs(interp, 3, objv, "index ?index ...?");
+ return TCL_ERROR;
+ }
+ for (i = 3; i < objc; i++) {
+ Table_WinDelete(tablePtr, Tcl_GetString(objv[i]));
+ }
+ break;
+
+ case WIN_MOVE:
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 3, objv, "srcIndex destIndex");
+ return TCL_ERROR;
+ }
+ result = Table_WinMove(tablePtr, Tcl_GetString(objv[3]),
+ Tcl_GetString(objv[4]), INV_FORCE);
+ break;
+
+ case WIN_NAMES: {
+ Tcl_Obj *objPtr = Tcl_NewObj();
+
+ /* just print out the window names */
+ if (objc < 3 || objc > 4) {
+ Tcl_WrongNumArgs(interp, 3, objv, "?pattern?");
+ return TCL_ERROR;
+ }
+ winname = (objc == 4) ? Tcl_GetString(objv[3]) : NULL;
+ entryPtr = Tcl_FirstHashEntry(tablePtr->winTable, &search);
+ while (entryPtr != NULL) {
+ keybuf = Tcl_GetHashKey(tablePtr->winTable, entryPtr);
+ if (objc == 3 || Tcl_StringMatch(keybuf, winname)) {
+ Tcl_ListObjAppendElement(NULL, objPtr,
+ Tcl_NewStringObj(keybuf, -1));
+ }
+ entryPtr = Tcl_NextHashEntry(&search);
+ }
+ Tcl_SetObjResult(interp, TableCellSortObj(interp, objPtr));
+ break;
+ }
+ }
+ return TCL_OK;
+}
diff --git a/tktable/generic/version.h b/tktable/generic/version.h
new file mode 100644
index 0000000..91d1bbe
--- /dev/null
+++ b/tktable/generic/version.h
@@ -0,0 +1,8 @@
+#if 0
+TBL_MAJOR_VERSION = 2
+TBL_MINOR_VERSION = 10
+PACKAGE_VERSION = $(TBL_MAJOR_VERSION).$(TBL_MINOR_VERSION)
+#endif
+#define TBL_MAJOR_VERSION 2
+#define TBL_MINOR_VERSION 10
+#define PACKAGE_VERSION "2.10"
diff --git a/tktable/library/tkTable.tcl b/tktable/library/tkTable.tcl
new file mode 100644
index 0000000..53a2e7f
--- /dev/null
+++ b/tktable/library/tkTable.tcl
@@ -0,0 +1,825 @@
+# table.tcl --
+#
+# Version align with tkTable 2.7, jeff at hobbs org
+# This file defines the default bindings for Tk table widgets
+# and provides procedures that help in implementing those bindings.
+#
+# RCS: @(#) $Id: tkTable.tcl,v 1.14 2005/07/12 23:26:28 hobbs Exp $
+
+#--------------------------------------------------------------------------
+# ::tk::table::Priv elements used in this file:
+#
+# x && y - Coords in widget
+# afterId - Token returned by "after" for autoscanning.
+# tablePrev - The last element to be selected or deselected
+# during a selection operation.
+# mouseMoved - Boolean to indicate whether mouse moved while
+# the button was pressed.
+# borderInfo - Boolean to know if the user clicked on a border
+# borderB1 - Boolean that set whether B1 can be used for the
+# interactiving resizing
+#--------------------------------------------------------------------------
+
+namespace eval ::tk::table {
+ # Ensure that a namespace is created for us
+ variable Priv
+ array set Priv [list x 0 y 0 afterId {} mouseMoved 0 \
+ borderInfo {} borderB1 1]
+}
+
+# ::tk::table::ClipboardKeysyms --
+# This procedure is invoked to identify the keys that correspond to
+# the "copy", "cut", and "paste" functions for the clipboard.
+#
+# Arguments:
+# copy - Name of the key (keysym name plus modifiers, if any,
+# such as "Meta-y") used for the copy operation.
+# cut - Name of the key used for the cut operation.
+# paste - Name of the key used for the paste operation.
+
+proc ::tk::table::ClipboardKeysyms {copy cut paste} {
+ bind Table <$copy> {tk_tableCopy %W}
+ bind Table <$cut> {tk_tableCut %W}
+ bind Table <$paste> {tk_tablePaste %W}
+}
+::tk::table::ClipboardKeysyms
+
+##
+## Interactive cell resizing, affected by -resizeborders option
+##
+bind Table <3> {
+ ## You might want to check for cell returned if you want to
+ ## restrict the resizing of certain cells
+ %W border mark %x %y
+}
+bind Table { %W border dragto %x %y }
+
+## Button events
+
+bind Table <1> { ::tk::table::Button1 %W %x %y }
+bind Table { ::tk::table::B1Motion %W %x %y }
+
+bind Table {
+ if {$::tk::table::Priv(borderInfo) == "" && [winfo exists %W]} {
+ ::tk::table::CancelRepeat
+ %W activate @%x,%y
+ }
+}
+bind Table {
+ # empty
+}
+
+bind Table {::tk::table::BeginExtend %W [%W index @%x,%y]}
+bind Table {::tk::table::BeginToggle %W [%W index @%x,%y]}
+bind Table {::tk::table::CancelRepeat}
+bind Table {
+ if {$::tk::table::Priv(borderInfo) == ""} {
+ array set ::tk::table::Priv {x %x y %y}
+ ::tk::table::AutoScan %W
+ }
+}
+bind Table <2> {
+ %W scan mark %x %y
+ array set ::tk::table::Priv {x %x y %y}
+ set ::tk::table::Priv(mouseMoved) 0
+}
+bind Table {
+ if {(%x != $::tk::table::Priv(x)) || (%y != $::tk::table::Priv(y))} {
+ set ::tk::table::Priv(mouseMoved) 1
+ }
+ if {$::tk::table::Priv(mouseMoved)} { %W scan dragto %x %y }
+}
+bind Table {
+ if {!$::tk::table::Priv(mouseMoved)} { tk_tablePaste %W [%W index @%x,%y] }
+}
+
+## Key events
+
+# This forces a cell commit if an active cell exists
+bind Table <> {
+ catch {%W activate active}
+}
+# Remove this if you don't want cell commit to occur on every Leave for
+# the table (via mouse) or FocusOut (loss of focus by table).
+event add <>