diff options
author | William Joye <wjoye@cfa.harvard.edu> | 2019-01-07 21:33:12 (GMT) |
---|---|---|
committer | William Joye <wjoye@cfa.harvard.edu> | 2019-01-07 21:33:12 (GMT) |
commit | 9d9bd29f4c4f54a064f2cf2ab7f51244a235839d (patch) | |
tree | 26340b4567650fefdb4a915b41db5b993546741c /tktable/generic | |
parent | 1c463eec511ffd93b99d7de57821c018bbfc0b24 (diff) | |
parent | add018f8b224a906e0c85e0740919e68d15f6854 (diff) | |
download | blt-9d9bd29f4c4f54a064f2cf2ab7f51244a235839d.zip blt-9d9bd29f4c4f54a064f2cf2ab7f51244a235839d.tar.gz blt-9d9bd29f4c4f54a064f2cf2ab7f51244a235839d.tar.bz2 |
Merge commit 'add018f8b224a906e0c85e0740919e68d15f6854' as 'tktable'
Diffstat (limited to 'tktable/generic')
-rw-r--r-- | tktable/generic/tkAppInit.c | 132 | ||||
-rw-r--r-- | tktable/generic/tkTable.c | 4090 | ||||
-rw-r--r-- | tktable/generic/tkTable.h | 658 | ||||
-rw-r--r-- | tktable/generic/tkTableCell.c | 1420 | ||||
-rw-r--r-- | tktable/generic/tkTableCellSort.c | 400 | ||||
-rwxr-xr-x | tktable/generic/tkTableCmds.c | 1306 | ||||
-rw-r--r-- | tktable/generic/tkTableEdit.c | 723 | ||||
-rw-r--r-- | tktable/generic/tkTableInitScript.h | 90 | ||||
-rw-r--r-- | tktable/generic/tkTablePs.c | 1299 | ||||
-rw-r--r-- | tktable/generic/tkTableTag.c | 1354 | ||||
-rw-r--r-- | tktable/generic/tkTableUtil.c | 372 | ||||
-rw-r--r-- | tktable/generic/tkTableWin.c | 955 | ||||
-rwxr-xr-x | tktable/generic/version.h | 8 |
13 files changed, 12807 insertions, 0 deletions
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..efb5f21 --- /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.3 2016/01/27 19:43:23 joye 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, "<index> ?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..32d5807 --- /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.2 2016/01/12 18:59:57 joye Exp $ + */ + +#ifndef _TKTABLE_H_ +#define _TKTABLE_H_ + +#include <string.h> +#include <stdlib.h> +#include <ctype.h> +#include <tk.h> +#ifdef MAC_TCL +# include <Xatom.h> +#else +# include <X11/Xatom.h> +#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 <windows.h> +# 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 const 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 const 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..4642aaa --- /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.1.1.1 2011/03/01 20:00:38 joye 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 <row>,<col>", + (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; i<max; i++) { + str = TableGetCellValue(tablePtr, row, i); + Tcl_ListObjAppendElement(NULL, resultPtr, + Tcl_NewStringObj(str, -1)); + } + } else { + max = tablePtr->rows+tablePtr->rowOffset; + for (i=row; i<max; i++) { + str = TableGetCellValue(tablePtr, i, col); + Tcl_ListObjAppendElement(NULL, resultPtr, + Tcl_NewStringObj(str, -1)); + } + } + } else if (tablePtr->state == 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 100755 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<objc; i++) { + /* set new width|height here */ + value = -999999; + if (Tcl_GetIntFromObj(interp, objv[i++], &posn) != TCL_OK || + (strcmp(Tcl_GetString(objv[i]), "default") && + Tcl_GetIntFromObj(interp, objv[i], &value) != TCL_OK)) { + return TCL_ERROR; + } + posn -= offset; + if (value == -999999) { + /* reset that field */ + entryPtr = Tcl_FindHashEntry(hashTablePtr, (char *) posn); + if (entryPtr != NULL) { + Tcl_DeleteHashEntry(entryPtr); + } + } else { + entryPtr = Tcl_CreateHashEntry(hashTablePtr, + (char *) posn, &dummy); + Tcl_SetHashValue(entryPtr, (ClientData) value); + } + } + TableAdjustParams(tablePtr); + /* rerequest geometry */ + TableGeometryRequest(tablePtr); + /* + * Invalidate the whole window as TableAdjustParams + * will only check to see if the top left cell has moved + * FIX: should just move from lowest order visible cell + * to edge of window + */ + TableInvalidateAll(tablePtr, 0); + } + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * Table_BboxCmd -- + * 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_BboxCmd(ClientData clientData, register Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[]) +{ + register Table *tablePtr = (Table *) clientData; + int x, y, w, h, row, col, key; + Tcl_Obj *resultPtr; + + /* Returns bounding box of cell(s) */ + if (objc < 3 || objc > 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, "?<value>?"); + 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|<first> ?<last>?"); + 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..4c56710 --- /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.3 2016/01/27 19:43:23 joye 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 <stdarg.h> +#else +#include <varargs.h> +#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..f3d7ee8 --- /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.3 2016/01/27 19:43:23 joye 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..16fa8b4 --- /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.2 2016/01/12 18:59:57 joye 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. + * + *---------------------------------------------------------------------- + */ + +const 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. + * + *---------------------------------------------------------------------- + */ + +const 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..2a59088 --- /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.2 2016/01/12 18:59:57 joye 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 const 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 const 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 100755 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" |