1 /*
2  * tkTable.c --
3  *
4  *	This module implements table widgets for the Tk
5  *	toolkit.  An table displays a 2D array of strings
6  *	and allows the strings to be edited.
7  *
8  * Based on Tk3 table widget written by Roland King
9  *
10  * Updates 1996 by:
11  * Jeffrey Hobbs	jeff.hobbs@acm.org
12  * John Ellson		ellson@lucent.com
13  * Peter Bruecker	peter@bj-ig.de
14  * Tom Moore		tmoore@spatial.ca
15  * Sebastian Wangnick	wangnick@orthogon.de
16  *
17  * Copyright (c) 1997-2002 Jeffrey Hobbs
18  *
19  * See the file "license.txt" for information on usage and redistribution
20  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
21  *
22  * RCS: @(#) $Id: tkTable.c,v 1.3 2005/01/26 15:27:59 A0182636 Exp $
23  */
24 
25 #include "tkTable.h"
26 #include "tkPort.h"
27 #include "tkInt.h"
28 #include "tkVMacro.h"
29 
30 /* perltk debug only for picking up forward referenced definitions */
31 /* #include "myinc.h"  */
32 
33 /* Perltk: XSETCLIP doesn't Appear to be there for perltk so always
34   define this : */
35 #define NO_XSETCLIP
36 
37 /* Not Needed??? */
38 /* static char **		StringifyObjects _ANSI_ARGS_((int objc,
39 			Tcl_Obj *CONST objv[]));
40 */
41 
42 
43 static int	TableWidgetObjCmd _ANSI_ARGS_((ClientData clientData,
44 			Tcl_Interp *interp, int objc, Tcl_Obj * objv[]));
45 static int	TableConfigure _ANSI_ARGS_((Tcl_Interp *interp,
46 			Table *tablePtr, int objc, Tcl_Obj *CONST objv[],
47 			int flags, int forceUpdate));
48 static void	TableDestroy _ANSI_ARGS_((ClientData clientdata));
49 static void	TableEventProc _ANSI_ARGS_((ClientData clientData,
50 			XEvent *eventPtr));
51 static void	TableCmdDeletedProc _ANSI_ARGS_((ClientData clientData));
52 
53 static void	TableRedrawHighlight _ANSI_ARGS_((Table *tablePtr));
54 static void	TableGetGc _ANSI_ARGS_((Display *display, Drawable d,
55 			TableTag *tagPtr, GC *tagGc));
56 
57 static void	TableDisplay _ANSI_ARGS_((ClientData clientdata));
58 static void	TableFlashEvent _ANSI_ARGS_((ClientData clientdata));
59 static char *	TableVarProc _ANSI_ARGS_((ClientData clientData,
60 			Tcl_Interp *interp, Var name, char *index,
61 			int flags));
62 static void	TableCursorEvent _ANSI_ARGS_((ClientData clientData));
63 static int	TableFetchSelection _ANSI_ARGS_((ClientData clientData,
64 			int offset, char *buffer, int maxBytes));
65 static Tk_RestrictAction TableRestrictProc _ANSI_ARGS_((ClientData arg,
66 			XEvent *eventPtr));
67 
68 /*
69  * The following tables define the widget commands (and sub-
70  * commands) and map the indexes into the string tables into
71  * enumerated types used to dispatch the widget command.
72  */
73 
74 static CONST84 char *selCmdNames[] = {
75     "anchor", "clear", "includes", "present", "set", (char *)NULL
76 };
77 enum selCommand {
78     CMD_SEL_ANCHOR, CMD_SEL_CLEAR, CMD_SEL_INCLUDES, CMD_SEL_PRESENT,
79     CMD_SEL_SET
80 };
81 
82 static CONST84 char *commandNames[] = {
83     "activate", "bbox", "border", "cget", "clear", "configure",
84     "curselection", "curvalue", "delete", "get", "rowHeight",
85     "hidden", "icursor", "index", "insert",
86 #ifdef POSTSCRIPT
87     "postscript",
88 #endif
89     "reread", "scan", "see", "selection", "set",
90     "spans", "tag", "validate", "version", "window", "colWidth",
91     "xview", "yview", (char *)NULL
92 };
93 enum command {
94     CMD_ACTIVATE, CMD_BBOX, CMD_BORDER, CMD_CGET, CMD_CLEAR, CMD_CONFIGURE,
95     CMD_CURSEL, CMD_CURVALUE, CMD_DELETE, CMD_GET, CMD_HEIGHT,
96     CMD_HIDDEN, CMD_ICURSOR, CMD_INDEX, CMD_INSERT,
97 #ifdef POSTSCRIPT
98     CMD_POSTSCRIPT,
99 #endif
100     CMD_REREAD, CMD_SCAN, CMD_SEE, CMD_SELECTION, CMD_SET,
101     CMD_SPANS, CMD_TAG, CMD_VALIDATE, CMD_VERSION, CMD_WINDOW, CMD_WIDTH,
102     CMD_XVIEW, CMD_YVIEW
103 };
104 
105 /* -selecttype selection type options */
106 static Cmd_Struct sel_vals[]= {
107     {"row",	 SEL_ROW},
108     {"col",	 SEL_COL},
109     {"both",	 SEL_BOTH},
110     {"cell",	 SEL_CELL},
111     {"",	 0 }
112 };
113 
114 /* -resizeborders options */
115 static Cmd_Struct resize_vals[]= {
116     {"row",	 SEL_ROW},		/* allow rows to be dragged */
117     {"col",	 SEL_COL},		/* allow cols to be dragged */
118     {"both",	 SEL_ROW|SEL_COL},	/* allow either to be dragged */
119     {"none",	 SEL_NONE},		/* allow nothing to be dragged */
120     {"",	 0 }
121 };
122 
123 /* drawmode values */
124 /* The display redraws with a pixmap using TK function calls */
125 #define	DRAW_MODE_SLOW		(1<<0)
126 /* The redisplay is direct to the screen, but TK function calls are still
127  * used to give correct 3-d border appearance and thus remain compatible
128  * with other TK apps */
129 #define	DRAW_MODE_TK_COMPAT	(1<<1)
130 /* the redisplay goes straight to the screen and the 3d borders are rendered
131  * with a single pixel wide line only. It cheats and uses the internal
132  * border structure to do the borders */
133 #define DRAW_MODE_FAST		(1<<2)
134 #define DRAW_MODE_SINGLE	(1<<3)
135 
136 static Cmd_Struct drawmode_vals[] = {
137     {"fast",		DRAW_MODE_FAST},
138     {"compatible",	DRAW_MODE_TK_COMPAT},
139     {"slow",		DRAW_MODE_SLOW},
140     {"single",		DRAW_MODE_SINGLE},
141     {"", 0}
142 };
143 
144 /* stretchmode values */
145 #define	STRETCH_MODE_NONE	(1<<0)	/* No additional pixels will be
146 					   added to rows or cols */
147 #define	STRETCH_MODE_UNSET	(1<<1)	/* All default rows or columns will
148 					   be stretched to fill the screen */
149 #define STRETCH_MODE_ALL	(1<<2)	/* All rows/columns will be padded
150 					   to fill the window */
151 #define STRETCH_MODE_LAST	(1<<3)	/* Stretch last elememt to fill
152 					   window */
153 #define STRETCH_MODE_FILL       (1<<4)	/* More ROWS in Window */
154 
155 static Cmd_Struct stretch_vals[] = {
156     {"none",	STRETCH_MODE_NONE},
157     {"unset",	STRETCH_MODE_UNSET},
158     {"all",	STRETCH_MODE_ALL},
159     {"last",	STRETCH_MODE_LAST},
160     {"fill",	STRETCH_MODE_FILL},
161     {"", 0}
162 };
163 
164 static Cmd_Struct state_vals[]= {
165     {"normal",	 STATE_NORMAL},
166     {"disabled", STATE_DISABLED},
167     {"",	 0 }
168 };
169 
170 /* The widget configuration table */
171 static Tk_CustomOption drawOpt		= { Cmd_OptionSet, Cmd_OptionGet,
172 					    (ClientData)(&drawmode_vals) };
173 static Tk_CustomOption resizeTypeOpt	= { Cmd_OptionSet, Cmd_OptionGet,
174 					    (ClientData)(&resize_vals) };
175 static Tk_CustomOption stretchOpt	= { Cmd_OptionSet, Cmd_OptionGet,
176 					    (ClientData)(&stretch_vals) };
177 static Tk_CustomOption selTypeOpt	= { Cmd_OptionSet, Cmd_OptionGet,
178 					    (ClientData)(&sel_vals) };
179 static Tk_CustomOption stateTypeOpt	= { Cmd_OptionSet, Cmd_OptionGet,
180 					    (ClientData)(&state_vals) };
181 static Tk_CustomOption bdOpt		= { TableOptionBdSet, TableOptionBdGet,
182 					    (ClientData) BD_TABLE };
183 
184 Tk_ConfigSpec tableSpecs[] = {
185     {TK_CONFIG_ANCHOR, "-anchor", "anchor", "Anchor", "center",
186      Tk_Offset(Table, defaultTag.anchor), 0},
187     {TK_CONFIG_BOOLEAN, "-autoclear", "autoClear", "AutoClear", "0",
188      Tk_Offset(Table, autoClear), 0},
189     {TK_CONFIG_BORDER, "-background", "background", "Background", NORMAL_BG,
190      Tk_Offset(Table, defaultTag.bg), 0},
191     {TK_CONFIG_SYNONYM, "-bd", "borderWidth", (char *)NULL, (char *)NULL, 0, 0},
192     {TK_CONFIG_SYNONYM, "-bg", "background", (char *)NULL, (char *)NULL, 0, 0},
193     {TK_CONFIG_CURSOR, "-bordercursor", "borderCursor", "Cursor", "crosshair",
194      Tk_Offset(Table, bdcursor), TK_CONFIG_NULL_OK },
195     {TK_CONFIG_CUSTOM, "-borderwidth", "borderWidth", "BorderWidth", "1",
196      Tk_Offset(Table, defaultTag), TK_CONFIG_NULL_OK, &bdOpt },
197     {TK_CONFIG_CALLBACK, "-browsecommand", "browseCommand", "BrowseCommand", "",
198      Tk_Offset(Table, browseCmd), TK_CONFIG_NULL_OK},
199     {TK_CONFIG_SYNONYM, "-browsecmd", "browseCommand", (char *)NULL,
200      (char *)NULL, 0, TK_CONFIG_NULL_OK},
201     {TK_CONFIG_BOOLEAN, "-cache", "cache", "Cache", "0",
202      Tk_Offset(Table, caching), 0},
203     {TK_CONFIG_INT, "-colorigin", "colOrigin", "Origin", "0",
204      Tk_Offset(Table, colOffset), 0},
205     {TK_CONFIG_INT, "-cols", "cols", "Cols", "10",
206      Tk_Offset(Table, cols), 0},
207     {TK_CONFIG_STRING, "-colseparator", "colSeparator", "Separator", "\t",
208      Tk_Offset(Table, colSep), TK_CONFIG_NULL_OK },
209     {TK_CONFIG_CUSTOM, "-colstretchmode", "colStretch", "StretchMode", "none",
210      Tk_Offset (Table, colStretch), 0 , &stretchOpt },
211     {TK_CONFIG_CALLBACK, "-coltagcommand", "colTagCommand", "TagCommand", NULL,
212      Tk_Offset(Table, colTagCmd), TK_CONFIG_NULL_OK },
213     {TK_CONFIG_INT, "-colwidth", "colWidth", "ColWidth", "10",
214      Tk_Offset(Table, defColWidth), 0},
215     {TK_CONFIG_CALLBACK, "-command", "command", "Command", "",
216      Tk_Offset(Table, command), TK_CONFIG_NULL_OK},
217     {TK_CONFIG_ACTIVE_CURSOR, "-cursor", "cursor", "Cursor", "xterm",
218      Tk_Offset(Table, cursor), TK_CONFIG_NULL_OK },
219     {TK_CONFIG_CUSTOM, "-drawmode", "drawMode", "DrawMode", "compatible",
220      Tk_Offset(Table, drawMode), 0, &drawOpt },
221     {TK_CONFIG_BOOLEAN, "-exportselection", "exportSelection",
222      "ExportSelection", "1", Tk_Offset(Table, exportSelection), 0},
223     {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *)NULL, (char *)NULL, 0, 0},
224     {TK_CONFIG_BOOLEAN, "-flashmode", "flashMode", "FlashMode", "0",
225      Tk_Offset(Table, flashMode), 0},
226     {TK_CONFIG_INT, "-flashtime", "flashTime", "FlashTime", "2",
227      Tk_Offset(Table, flashTime), 0},
228     {TK_CONFIG_FONT, "-font", "font", "Font",  DEF_TABLE_FONT,
229      Tk_Offset(Table, defaultTag.tkfont), 0},
230     {TK_CONFIG_BORDER, "-foreground", "foreground", "Foreground", "black",
231      Tk_Offset(Table, defaultTag.fg), 0},
232 #ifdef PROCS
233     {TK_CONFIG_BOOLEAN, "-hasprocs", "hasProcs", "hasProcs", "0",
234      Tk_Offset(Table, hasProcs), 0},
235 #endif
236     {TK_CONFIG_INT, "-height", "height", "Height", "0",
237      Tk_Offset(Table, maxReqRows), 0},
238     {TK_CONFIG_COLOR, "-highlightbackground", "highlightBackground",
239      "HighlightBackground", NORMAL_BG, Tk_Offset(Table, highlightBgColorPtr), 0},
240     {TK_CONFIG_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
241      HIGHLIGHT, Tk_Offset(Table, highlightColorPtr), 0},
242     {TK_CONFIG_PIXELS, "-highlightthickness", "highlightThickness",
243      "HighlightThickness", "2", Tk_Offset(Table, highlightWidth), 0},
244     {TK_CONFIG_BORDER, "-insertbackground", "insertBackground", "Foreground",
245      "Black", Tk_Offset(Table, insertBg), 0},
246     {TK_CONFIG_PIXELS, "-insertborderwidth", "insertBorderWidth", "BorderWidth",
247      "0", Tk_Offset(Table, insertBorderWidth), TK_CONFIG_COLOR_ONLY},
248     {TK_CONFIG_PIXELS, "-insertborderwidth", "insertBorderWidth", "BorderWidth",
249      "0", Tk_Offset(Table, insertBorderWidth), TK_CONFIG_MONO_ONLY},
250     {TK_CONFIG_INT, "-insertofftime", "insertOffTime", "OffTime", "300",
251      Tk_Offset(Table, insertOffTime), 0},
252     {TK_CONFIG_INT, "-insertontime", "insertOnTime", "OnTime", "600",
253      Tk_Offset(Table, insertOnTime), 0},
254     {TK_CONFIG_PIXELS, "-insertwidth", "insertWidth", "InsertWidth", "2",
255      Tk_Offset(Table, insertWidth), 0},
256     {TK_CONFIG_BOOLEAN, "-invertselected", "invertSelected", "InvertSelected",
257      "0", Tk_Offset(Table, invertSelected), 0},
258     {TK_CONFIG_PIXELS, "-ipadx", "ipadX", "Pad", "0",
259      Tk_Offset(Table, ipadX), 0},
260     {TK_CONFIG_PIXELS, "-ipady", "ipadY", "Pad", "0",
261      Tk_Offset(Table, ipadY), 0},
262     {TK_CONFIG_JUSTIFY, "-justify", "justify", "Justify", "left",
263      Tk_Offset(Table, defaultTag.justify), 0 },
264     {TK_CONFIG_PIXELS, "-maxheight", "maxHeight", "MaxHeight", "600",
265      Tk_Offset(Table, maxReqHeight), 0},
266     {TK_CONFIG_PIXELS, "-maxwidth", "maxWidth", "MaxWidth", "800",
267      Tk_Offset(Table, maxReqWidth), 0},
268     {TK_CONFIG_BOOLEAN, "-multiline", "multiline", "Multiline", "1",
269      Tk_Offset(Table, defaultTag.multiline), 0},
270     {TK_CONFIG_PIXELS, "-padx", "padX", "Pad", "0", Tk_Offset(Table, padX), 0},
271     {TK_CONFIG_PIXELS, "-pady", "padY", "Pad", "0", Tk_Offset(Table, padY), 0},
272     {TK_CONFIG_RELIEF, "-relief", "relief", "Relief", "sunken",
273      Tk_Offset(Table, defaultTag.relief), 0},
274     {TK_CONFIG_CUSTOM, "-resizeborders", "resizeBorders", "ResizeBorders",
275      "both", Tk_Offset(Table, resize), 0, &resizeTypeOpt },
276     {TK_CONFIG_INT, "-rowheight", "rowHeight", "RowHeight", "1",
277      Tk_Offset(Table, defRowHeight), 0},
278     {TK_CONFIG_INT, "-roworigin", "rowOrigin", "Origin", "0",
279      Tk_Offset(Table, rowOffset), 0},
280     {TK_CONFIG_INT, "-rows", "rows", "Rows", "10", Tk_Offset(Table, rows), 0},
281     {TK_CONFIG_STRING, "-rowseparator", "rowSeparator", "Separator", "\n",
282      Tk_Offset(Table, rowSep), TK_CONFIG_NULL_OK },
283     {TK_CONFIG_CUSTOM, "-rowstretchmode", "rowStretch", "StretchMode", "none",
284      Tk_Offset(Table, rowStretch), 0 , &stretchOpt },
285     {TK_CONFIG_CALLBACK, "-rowtagcommand", "rowTagCommand", "TagCommand", NULL,
286      Tk_Offset(Table, rowTagCmd), TK_CONFIG_NULL_OK },
287     {TK_CONFIG_SYNONYM, "-selcmd", "selectionCommand", (char *)NULL,
288      (char *)NULL, 0, TK_CONFIG_NULL_OK},
289     {TK_CONFIG_CALLBACK, "-selectioncommand", "selectionCommand",
290      "SelectionCommand", NULL, Tk_Offset(Table, selCmd), TK_CONFIG_NULL_OK },
291     {TK_CONFIG_STRING, "-selectmode", "selectMode", "SelectMode", "browse",
292      Tk_Offset(Table, selectMode), TK_CONFIG_NULL_OK },
293     {TK_CONFIG_BOOLEAN, "-selecttitles", "selectTitles", "SelectTitles", "0",
294      Tk_Offset(Table, selectTitles), 0},
295     {TK_CONFIG_CUSTOM, "-selecttype", "selectType", "SelectType", "cell",
296      Tk_Offset(Table, selectType), 0, &selTypeOpt },
297 #ifdef PROCS
298     {TK_CONFIG_BOOLEAN, "-showprocs", "showProcs", "showProcs", "0",
299      Tk_Offset(Table, showProcs), 0},
300 #endif
301     {TK_CONFIG_BOOLEAN, "-sparsearray", "sparseArray", "SparseArray", "1",
302      Tk_Offset(Table, sparse), 0},
303     {TK_CONFIG_CUSTOM, "-state", "state", "State", "normal",
304      Tk_Offset(Table, state), 0, &stateTypeOpt},
305     {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus", (char *)NULL,
306      Tk_Offset(Table, takeFocus), TK_CONFIG_NULL_OK },
307     {TK_CONFIG_INT, "-titlecols", "titleCols", "TitleCols", "0",
308      Tk_Offset(Table, titleCols), TK_CONFIG_NULL_OK },
309 #ifdef TITLE_CURSOR
310     {TK_CONFIG_CURSOR, "-titlecursor", "titleCursor", "Cursor", "arrow",
311      Tk_Offset(Table, titleCursor), TK_CONFIG_NULL_OK },
312 #endif
313     {TK_CONFIG_INT, "-titlerows", "titleRows", "TitleRows", "0",
314      Tk_Offset(Table, titleRows), TK_CONFIG_NULL_OK },
315     {TK_CONFIG_BOOLEAN, "-usecommand", "useCommand", "UseCommand", "1",
316      Tk_Offset(Table, useCmd), 0},
317     {TK_CONFIG_SCALARVAR, "-variable", "variable", "Variable", (char *)NULL,
318      Tk_Offset(Table, arrayVar), TK_CONFIG_NULL_OK },
319     {TK_CONFIG_BOOLEAN, "-validate", "validate", "Validate", "0",
320      Tk_Offset(Table, validate), 0},
321     {TK_CONFIG_CALLBACK, "-validatecommand", "validateCommand", "ValidateCommand",
322      "", Tk_Offset(Table, valCmd), TK_CONFIG_NULL_OK},
323     {TK_CONFIG_SYNONYM, "-vcmd", "validateCommand", (char *)NULL,
324      (char *)NULL, 0, TK_CONFIG_NULL_OK},
325     {TK_CONFIG_INT, "-width", "width", "Width", "0",
326      Tk_Offset(Table, maxReqCols), 0},
327     {TK_CONFIG_BOOLEAN, "-wrap", "wrap", "Wrap", "0",
328      Tk_Offset(Table, defaultTag.wrap), 0},
329     {TK_CONFIG_CALLBACK, "-xscrollcommand", "xScrollCommand", "ScrollCommand",
330      NULL, Tk_Offset(Table, xScrollCmd), TK_CONFIG_NULL_OK },
331     {TK_CONFIG_CALLBACK, "-yscrollcommand", "yScrollCommand", "ScrollCommand",
332      NULL, Tk_Offset(Table, yScrollCmd), TK_CONFIG_NULL_OK },
333     {TK_CONFIG_END, (char *)NULL, (char *)NULL, (char *)NULL,
334      (char *)NULL, 0, 0}
335 };
336 
337 /*
338  * This specifies the configure options that will cause an update to
339  * occur, so we should have a quick lookup table for them.
340  * Keep this in sync with the above values.
341  */
342 
343 static CONST84 char *updateOpts[] = {
344     "-anchor",		"-background",	"-bg",		"-bd",
345     "-borderwidth",	"-cache",	"-command",	"-colorigin",
346     "-cols",		"-colstretchmode",		"-coltagcommand",
347     "-drawmode",	"-fg",		"-font",	"-foreground",
348     "-hasprocs",	"-height",	"-highlightbackground",
349     "-highlightcolor",	"-highlightthickness",		"-insertbackground",
350     "-insertborderwidth",		"-insertwidth",	"-invertselected",
351     "-ipadx",		"-ipady",
352     "-maxheight",	"-maxwidth",	"-multiline",
353     "-padx",		"-pady",	"-relief",	"-roworigin",
354     "-rows",		"-rowstretchmode",		"-rowtagcommand",
355     "-showprocs",	"-state",	"-titlecols",	"-titlerows",
356     "-usecommand",	"-variable",	"-width",	"-wrap",
357     "-xscrollcommand",	"-yscrollcommand", (char *) NULL
358 };
359 
360 #ifdef WIN32
361 /*
362  * Some code from TkWinInt.h that we use to correct and speed up
363  * drawing of cells that need clipping in TableDisplay.
364  */
365 typedef struct {
366     int type;
367     HWND handle;
368     void *winPtr;
369 } TkWinWindow;
370 
371 typedef struct {
372     int type;
373     HBITMAP handle;
374     Colormap colormap;
375     int depth;
376 } TkWinBitmap;
377 
378 typedef struct {
379     int type;
380     HDC hdc;
381 } TkWinDC;
382 
383 typedef union {
384     int type;
385     TkWinWindow window;
386     TkWinBitmap bitmap;
387     TkWinDC winDC;
388 } TkWinDrawable;
389 #endif
390 
391 /*
392  * END HEADER INFORMATION
393  */
394 
395 /*
396  *---------------------------------------------------------------------------
397  *
398  * StringifyObjects -- (from tclCmdAH.c)
399  *
400  *	Helper function to bridge the gap between an object-based procedure
401  *	and an older string-based procedure.
402  *
403  *	Given an array of objects, allocate an array that consists of the
404  *	string representations of those objects.
405  *
406  * Results:
407  *	The return value is a pointer to the newly allocated array of
408  *	strings.  Elements 0 to (objc-1) of the string array point to the
409  *	string representation of the corresponding element in the source
410  *	object array; element objc of the string array is NULL.
411  *
412  * Side effects:
413  *	Memory allocated.  The caller must eventually free this memory
414  *	by calling ckfree() on the return value.
415  *
416 	    int result;
417 	    char **argv;
418 	    argv   = StringifyObjects(objc, objv);
419 	    result = StringBasedCmd(interp, objc, argv);
420 	    ckfree((char *) argv);
421 	    return result;
422  *
423  *---------------------------------------------------------------------------
424  */
425 
426 /* Don't Need This becuase arrays of Objects equivalent to arrays of Args????
427 static Arg *
428 StringifyObjects(objc, objv)
429      int objc;			/* Number of arguments.
430      Tcl_Obj *CONST objv[];	 Argument objects.
431 {
432     int i;
433     Arg *args; /* This needs to not be autoconverted to a Arg, so change the name to argsv
434 
435     args = (Arg *) ckalloc((objc + 1) * sizeof(Arg *));
436     for (i = 0; i < objc; i++) {
437     	args[i] = Tcl_GetString(objv[i]);
438     }
439     args[i] = NULL;
440     return args;
441 }
442 
443 
444 
445 /*
446  * As long as we wait for the Function in general
447  *
448  * This parses the "-class" option for the table.
449  */
450 static int
Tk_ClassOptionObjCmd(Tk_Window tkwin,char * defaultclass,int objc,Tcl_Obj * CONST objv[])451 Tk_ClassOptionObjCmd(Tk_Window tkwin, char *defaultclass,
452 		     int objc, Tcl_Obj *CONST objv[])
453 {
454     char *classname = defaultclass;
455     int offset = 0;
456 
457     if ((objc >= 4) && STREQ(Tcl_GetString(objv[2]),"-class")) {
458 	classname = Tcl_GetString(objv[3]);
459 	offset = 2;
460     }
461     Tk_SetClass(tkwin, classname);
462     return offset;
463 }
464 
465 /*
466  *--------------------------------------------------------------
467  *
468  * Tk_TableObjCmd --
469  *	This procedure is invoked to process the "table" Tcl
470  *	command.  See the user documentation for details on what
471  *	it does.
472  *
473  * Results:
474  *	A standard Tcl result.
475  *
476  * Side effects:
477  *	See the user documentation.
478  *
479  *--------------------------------------------------------------
480  */
481 int
Tk_TableObjCmd(clientData,interp,objc,objv)482 Tk_TableObjCmd(clientData, interp, objc, objv)
483     ClientData clientData;	/* Main window associated with interpreter. */
484     Tcl_Interp *interp;
485     int objc;			/* Number of arguments. */
486     Tcl_Obj *CONST objv[];	/* Argument objects. */
487 {
488     register Table *tablePtr;
489     Tk_Window tkwin, mainWin = (Tk_Window) clientData;
490     int offset;
491     if (objc < 2) {
492 	Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?");
493 	return TCL_ERROR;
494     }
495 
496     tkwin = Tk_CreateWindowFromPath(interp, mainWin, Tcl_GetString(objv[1]),
497 	    (char *)NULL);
498     if (tkwin == NULL) {
499 	return TCL_ERROR;
500     }
501 
502     tablePtr			= (Table *) ckalloc(sizeof(Table));
503     memset((VOID *) tablePtr, 0, sizeof(Table));
504 
505     /*
506      * Set the structure elments that aren't 0/NULL by default,
507      * and that won't be set by the initial configure call.
508      */
509     tablePtr->tkwin		= tkwin;
510     tablePtr->display		= Tk_Display(tkwin);
511     tablePtr->interp		= interp;
512     tablePtr->widgetCmd	= Lang_CreateWidget(interp,
513 	    tablePtr->tkwin, TableWidgetObjCmd,
514 	    (ClientData) tablePtr, (Tcl_CmdDeleteProc *) TableCmdDeletedProc);
515 
516     tablePtr->anchorRow		= -1;
517     tablePtr->anchorCol		= -1;
518     tablePtr->activeRow		= -1;
519     tablePtr->activeCol		= -1;
520     tablePtr->oldTopRow		= -1;
521     tablePtr->oldLeftCol	= -1;
522     tablePtr->oldActRow		= -1;
523     tablePtr->oldActCol		= -1;
524     tablePtr->seen[0]		= -1;
525 
526     tablePtr->dataSource	= DATA_NONE;
527     tablePtr->activeBuf		= ckalloc(1);
528     *(tablePtr->activeBuf)	= '\0';
529 
530     tablePtr->cursor		= None;
531     tablePtr->bdcursor		= None;
532 
533     tablePtr->defaultTag.justify	= TK_JUSTIFY_LEFT;
534     tablePtr->defaultTag.state		= STATE_UNKNOWN;
535 
536     /* misc tables */
537     tablePtr->tagTable	= (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
538     Tcl_InitHashTable(tablePtr->tagTable, TCL_STRING_KEYS);
539     tablePtr->winTable	= (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
540     Tcl_InitHashTable(tablePtr->winTable, TCL_STRING_KEYS);
541 
542     /* internal value cache */
543     tablePtr->cache	= (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
544     Tcl_InitHashTable(tablePtr->cache, TCL_STRING_KEYS);
545 
546     /* style hash tables */
547     tablePtr->colWidths = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
548     Tcl_InitHashTable(tablePtr->colWidths, TCL_ONE_WORD_KEYS);
549     tablePtr->rowHeights = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
550     Tcl_InitHashTable(tablePtr->rowHeights, TCL_ONE_WORD_KEYS);
551 
552     /* style hash tables */
553     tablePtr->rowStyles = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
554     Tcl_InitHashTable(tablePtr->rowStyles, TCL_ONE_WORD_KEYS);
555     tablePtr->colStyles = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
556     Tcl_InitHashTable(tablePtr->colStyles, TCL_ONE_WORD_KEYS);
557     tablePtr->cellStyles = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
558     Tcl_InitHashTable(tablePtr->cellStyles, TCL_STRING_KEYS);
559 
560     /* special style hash tables */
561     tablePtr->flashCells = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
562     Tcl_InitHashTable(tablePtr->flashCells, TCL_STRING_KEYS);
563     tablePtr->selCells = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
564     Tcl_InitHashTable(tablePtr->selCells, TCL_STRING_KEYS);
565 
566     /*
567      * List of tags in priority order.  30 is a good default number to alloc.
568      */
569     tablePtr->tagPrioMax = 30;
570     tablePtr->tagPrioNames = (char **) ckalloc(
571 	sizeof(char *) * tablePtr->tagPrioMax);
572     tablePtr->tagPrios = (TableTag **) ckalloc(
573 	sizeof(TableTag *) * tablePtr->tagPrioMax);
574     tablePtr->tagPrioSize = 0;
575     for (offset = 0; offset < tablePtr->tagPrioMax; offset++) {
576 	tablePtr->tagPrioNames[offset] = (char *) NULL;
577 	tablePtr->tagPrios[offset] = (TableTag *) NULL;
578     }
579 
580 #ifdef PROCS
581     tablePtr->inProc = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
582     Tcl_InitHashTable(tablePtr->inProc, TCL_STRING_KEYS);
583 #endif
584 
585 
586     /*
587      * Handle class name and selection handlers
588      */
589     offset = 2 + Tk_ClassOptionObjCmd(tkwin, "Table", objc, objv);
590     Tk_CreateEventHandler(tablePtr->tkwin,
591 	    PointerMotionMask|ExposureMask|StructureNotifyMask|FocusChangeMask|VisibilityChangeMask,
592 	    TableEventProc, (ClientData) tablePtr);
593     Tk_CreateSelHandler(tablePtr->tkwin, XA_PRIMARY, XA_STRING,
594 	    TableFetchSelection, (ClientData) tablePtr, XA_STRING);
595 
596     if (TableConfigure(interp, tablePtr, objc - offset, objv + offset,
597 	    0, 1 /* force update */) != TCL_OK) {
598 	Tk_DestroyWindow(tkwin);
599 	return TCL_ERROR;
600     }
601     TableInitTags(tablePtr);
602 
603     /*Tcl_SetStringObj(Tcl_GetObjResult(interp),
604 		     Tk_PathName(tablePtr->tkwin), -1);
605     */
606     /* Tk800.022 needs to old-style LangWidgetArg Call
607         newer perltk's should be ok with the default.
608     */
609 #ifdef USE_LANGWIDGETARG
610     Tcl_SetObjResult(interp, LangWidgetArg(interp,tablePtr->tkwin));
611 #else
612     Tcl_SetObjResult(interp, LangWidgetObj(interp,tablePtr->tkwin));
613 #endif
614 
615     return TCL_OK;
616 }
617 
618 /*
619  *--------------------------------------------------------------
620  *
621  * TableWidgetObjCmd --
622  *	This procedure is invoked to process the Tcl command
623  *	that corresponds to a widget managed by this module.
624  *	See the user documentation for details on what it does.
625  *
626  * Results:
627  *	A standard Tcl result.
628  *
629  * Side effects:
630  *	See the user documentation.
631  *
632  *--------------------------------------------------------------
633  */
634 static int
TableWidgetObjCmd(clientData,interp,objc,objv)635 TableWidgetObjCmd(clientData, interp, objc, objv)
636      ClientData clientData;
637      Tcl_Interp *interp;
638      int objc;			/* Number of arguments. */
639      Tcl_Obj * objv[];	        /* Argument objects. */
640 {
641     register Table *tablePtr = (Table *) clientData;
642     int row, col, i, cmdIndex, result = TCL_OK;
643 
644     if (objc < 2) {
645 	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
646 	return TCL_ERROR;
647     }
648 
649     /* parse the first parameter */
650     result = Tcl_GetIndexFromObj(interp, objv[1], commandNames,
651 				 "option", 0, &cmdIndex);
652     if (result != TCL_OK) {
653 	return result;
654     }
655 
656     Tcl_Preserve((ClientData) tablePtr);
657     switch ((enum command) cmdIndex) {
658 	case CMD_ACTIVATE:
659 	    result = Table_ActivateCmd(clientData, interp, objc, objv);
660 	    break;
661 
662 	case CMD_BBOX:
663 	    result = Table_BboxCmd(clientData, interp, objc, objv);
664 	    break;
665 
666 	case CMD_BORDER:
667 	    result = Table_BorderCmd(clientData, interp, objc, objv);
668 	    break;
669 
670 	case CMD_CGET:
671 	    if (objc != 3) {
672 		Tcl_WrongNumArgs(interp, 2, objv, "option");
673 		result = TCL_ERROR;
674 	    } else {
675 		result = Tk_ConfigureValue(interp, tablePtr->tkwin, tableSpecs,
676 			(char *) tablePtr, Tcl_GetString(objv[2]), 0);
677 	    }
678 	    break;
679 
680 	case CMD_CLEAR:
681 	    result = Table_ClearCmd(clientData, interp, objc, objv);
682 	    break;
683 
684 	case CMD_CONFIGURE:
685 	    if (objc < 4) {
686 		result = Tk_ConfigureInfo(interp, tablePtr->tkwin, tableSpecs,
687 			(char *) tablePtr, (objc == 3) ?
688 			Tcl_GetString(objv[2]) : (char *) NULL, 0);
689 	    } else {
690 		result = TableConfigure(interp, tablePtr, objc - 2, objv + 2,
691 			TK_CONFIG_ARGV_ONLY, 0);
692 	    }
693 	    break;
694 
695 	case CMD_CURSEL:
696 	    result = Table_CurselectionCmd(clientData, interp, objc, objv);
697 	    break;
698 
699 	case CMD_CURVALUE:
700 	    result = Table_CurvalueCmd(clientData, interp, objc, objv);
701 	    break;
702 
703 	case CMD_DELETE:
704 	case CMD_INSERT:
705 	    result = Table_EditCmd(clientData, interp, objc, objv);
706 	    break;
707 
708 	case CMD_GET:
709 	    result = Table_GetCmd(clientData, interp, objc, objv);
710 	    break;
711 
712 	case CMD_HEIGHT:
713 	    result = Table_AdjustCmd(clientData, interp, objc, objv,0);
714 	    break;
715 	case CMD_WIDTH:
716 	    result = Table_AdjustCmd(clientData, interp, objc, objv,1);
717 	    break;
718 
719 	case CMD_HIDDEN:
720 	    result = Table_HiddenCmd(clientData, interp, objc, objv);
721 	    break;
722 
723 	case CMD_ICURSOR:
724 	    if (objc != 2 && objc != 3) {
725 		Tcl_WrongNumArgs(interp, 2, objv, "?cursorPos?");
726 		result = TCL_ERROR;
727 		break;
728 	    }
729 	    if (!(tablePtr->flags & HAS_ACTIVE) ||
730 		    (tablePtr->flags & ACTIVE_DISABLED) ||
731 		    tablePtr->state == STATE_DISABLED) {
732 		Tcl_SetIntObj(Tcl_GetObjResult(interp), -1);
733 		break;
734 	    } else if (objc == 3) {
735 		if (TableGetIcursorObj(tablePtr, objv[2], NULL) != TCL_OK) {
736 		    result = TCL_ERROR;
737 		    break;
738 		}
739 		TableRefresh(tablePtr, tablePtr->activeRow,
740 			tablePtr->activeCol, CELL);
741 	    }
742 	    Tcl_SetIntObj(Tcl_GetObjResult(interp), tablePtr->icursor);
743 	    break;
744 
745 	case CMD_INDEX: {
746 	    char *which = NULL;
747 
748 	    if (objc == 4) {
749 		which = Tcl_GetString(objv[3]);
750 	    }
751 	    if ((objc < 3 || objc > 4) ||
752 		    ((objc == 4) && (strcmp(which, "row")
753 			    && strcmp(which, "col")))) {
754 		Tcl_WrongNumArgs(interp, 2, objv, "<index> ?row|col?");
755 		result = TCL_ERROR;
756 	    } else if (TableGetIndexObj(tablePtr, objv[2], &row, &col)
757 		    != TCL_OK) {
758 		result = TCL_ERROR;
759 	    } else if (objc == 3) {
760 		char buf[INDEX_BUFSIZE];
761 		/* recreate the index, just in case it got bounded */
762 		TableMakeArrayIndex(row, col, buf);
763 		Tcl_SetStringObj(Tcl_GetObjResult(interp), buf, -1);
764 	    } else {	/* INDEX row|col */
765 		Tcl_SetIntObj(Tcl_GetObjResult(interp),
766 			(*which == 'r') ? row : col);
767 	    }
768 	    break;
769 	}
770 
771 #ifdef POSTSCRIPT
772 	case CMD_POSTSCRIPT:
773 	    result = Table_PostscriptCmd(clientData, interp, objc, objv);
774 	    break;
775 #endif
776 
777 	case CMD_REREAD:
778 	    if (objc != 2) {
779 		Tcl_WrongNumArgs(interp, 2, objv, NULL);
780 		result = TCL_ERROR;
781 	    } else if ((tablePtr->flags & HAS_ACTIVE) &&
782 		    !(tablePtr->flags & ACTIVE_DISABLED) &&
783 		    tablePtr->state != STATE_DISABLED) {
784 		TableGetActiveBuf(tablePtr);
785 		TableRefresh(tablePtr, tablePtr->activeRow,
786 			tablePtr->activeCol, CELL|INV_FORCE);
787 	    }
788 	    break;
789 
790 	case CMD_SCAN:
791 	    result = Table_ScanCmd(clientData, interp, objc, objv);
792 	    break;
793 
794 	case CMD_SEE:
795 	    if (objc != 3) {
796 		Tcl_WrongNumArgs(interp, 2, objv, "index");
797 		result = TCL_ERROR;
798 	    } else if (TableGetIndexObj(tablePtr, objv[2],
799 		    &row, &col) == TCL_ERROR) {
800 		result = TCL_ERROR;
801 	    } else {
802 		/* Adjust from user to master coords */
803 		row -= tablePtr->rowOffset;
804 		col -= tablePtr->colOffset;
805 		if (!TableCellVCoords(tablePtr, row, col, &i, &i, &i, &i, 1)) {
806 		    tablePtr->topRow  = row-1;
807 		    tablePtr->leftCol = col-1;
808 		    TableAdjustParams(tablePtr);
809 		}
810 	    }
811 	    break;
812 
813 	case CMD_SELECTION:
814 	    if (objc < 3) {
815 		Tcl_WrongNumArgs(interp, 2, objv, "option ?arg arg ...?");
816 		result = TCL_ERROR;
817 		break;
818 	    }
819 	    if (Tcl_GetIndexFromObj(interp, objv[2], selCmdNames,
820 		    "selection option", 0, &cmdIndex) != TCL_OK) {
821 		result = TCL_ERROR;
822 		break;
823 	    }
824 	    switch ((enum selCommand) cmdIndex) {
825 		case CMD_SEL_ANCHOR:
826 		    result = Table_SelAnchorCmd(clientData, interp,
827 			    objc, objv);
828 		    break;
829 		case CMD_SEL_CLEAR:
830 		    result = Table_SelClearCmd(clientData, interp, objc, objv);
831 		    break;
832 		case CMD_SEL_INCLUDES:
833 		    result = Table_SelIncludesCmd(clientData, interp,
834 			    objc, objv);
835 		    break;
836 		case CMD_SEL_PRESENT: {
837 		    Tcl_HashSearch search;
838 
839 		    Tcl_SetBooleanObj(Tcl_GetObjResult(interp),
840 			    (Tcl_FirstHashEntry(tablePtr->selCells, &search)
841 				    != NULL));
842 		    break;
843 		}
844 		case CMD_SEL_SET:
845 		    result = Table_SelSetCmd(clientData, interp, objc, objv);
846 		    break;
847 	    }
848 	    break;
849 
850 	case CMD_SET:
851 	    result = Table_SetCmd(clientData, interp, objc, objv);
852 	    break;
853 
854 	case CMD_SPANS:
855 	    result = Table_SpanCmd(clientData, interp, objc, objv);
856 	    break;
857 
858 	case CMD_TAG:
859 	    result = Table_TagCmd(clientData, interp, objc, objv);
860 	    break;
861 
862 	case CMD_VALIDATE:
863 	    if (objc != 3) {
864 		Tcl_WrongNumArgs(interp, 2, objv, "index");
865 		result = TCL_ERROR;
866 	    } else if (TableGetIndexObj(tablePtr, objv[2],
867 		    &row, &col) == TCL_ERROR) {
868 		result = TCL_ERROR;
869 	    } else {
870 		i = tablePtr->validate;
871 		tablePtr->validate = 1;
872 		result = TableValidateChange(tablePtr, row, col, (char *) NULL,
873 			(char *) NULL, -1);
874 		tablePtr->validate = i;
875 		Tcl_SetBooleanObj(Tcl_GetObjResult(interp),
876 			(result == TCL_OK));
877 		result = TCL_OK;
878 	    }
879 	    break;
880 
881 	case CMD_VERSION:
882 	    if (objc != 2) {
883 		Tcl_WrongNumArgs(interp, 2, objv, NULL);
884 		result = TCL_ERROR;
885 	    } else {
886 		Tcl_SetStringObj(Tcl_GetObjResult(interp), VERSION, -1);
887 	    }
888 	    break;
889 
890 	case CMD_WINDOW:
891 	    result = Table_WindowCmd(clientData, interp, objc, objv);
892 	    break;
893 
894 	case CMD_XVIEW:
895 	case CMD_YVIEW:
896 	    result = Table_ViewCmd(clientData, interp, objc, objv);
897 	    break;
898     }
899 
900     Tcl_Release((ClientData) tablePtr);
901     return result;
902 }
903 
904 /*
905  *----------------------------------------------------------------------
906  *
907  * TableDestroy --
908  *	This procedure is invoked by Tcl_EventuallyFree
909  *	to clean up the internal structure of a table at a safe time
910  *	(when no-one is using it anymore).
911  *
912  * Results:
913  *	None.
914  *
915  * Side effects:
916  *	Everything associated with the table is freed up (hopefully).
917  *
918  *----------------------------------------------------------------------
919  */
920 static void
TableDestroy(ClientData clientdata)921 TableDestroy(ClientData clientdata)
922 {
923     register Table *tablePtr = (Table *) clientdata;
924     Tcl_HashEntry *entryPtr;
925     Tcl_HashSearch search;
926 
927     /* These may be repetitive from DestroyNotify, but it doesn't hurt */
928     /* cancel any pending update or timer */
929     if (tablePtr->flags & REDRAW_PENDING) {
930 	Tcl_CancelIdleCall(TableDisplay, (ClientData) tablePtr);
931 	tablePtr->flags &= ~REDRAW_PENDING;
932     }
933     Tcl_DeleteTimerHandler(tablePtr->cursorTimer);
934     Tcl_DeleteTimerHandler(tablePtr->flashTimer);
935 
936     /* delete the variable trace */
937     if (tablePtr->arrayVar != NULL) {
938 	Tcl_UntraceVar(tablePtr->interp, tablePtr->arrayVar,
939 		TCL_TRACE_WRITES | TCL_TRACE_UNSETS | TCL_GLOBAL_ONLY,
940 		(Tcl_VarTraceProc *)TableVarProc, (ClientData) tablePtr);
941     }
942 
943     /* free the int arrays */
944     if (tablePtr->colPixels) ckfree((char *) tablePtr->colPixels);
945     if (tablePtr->rowPixels) ckfree((char *) tablePtr->rowPixels);
946     if (tablePtr->colStarts) ckfree((char *) tablePtr->colStarts);
947     if (tablePtr->rowStarts) ckfree((char *) tablePtr->rowStarts);
948 
949     /* delete cached active tag and string */
950     if (tablePtr->activeTagPtr) ckfree((char *) tablePtr->activeTagPtr);
951     if (tablePtr->activeBuf != NULL) ckfree(tablePtr->activeBuf);
952 
953     /*
954      * Delete the various hash tables, make sure to clear the STRING_KEYS
955      * tables that allocate their strings:
956      *   cache, spanTbl (spanAffTbl shares spanTbl info)
957      */
958     Table_ClearHashTable(tablePtr->cache);
959     ckfree((char *) (tablePtr->cache));
960     Tcl_DeleteHashTable(tablePtr->rowStyles);
961     ckfree((char *) (tablePtr->rowStyles));
962     Tcl_DeleteHashTable(tablePtr->colStyles);
963     ckfree((char *) (tablePtr->colStyles));
964     Tcl_DeleteHashTable(tablePtr->cellStyles);
965     ckfree((char *) (tablePtr->cellStyles));
966     Tcl_DeleteHashTable(tablePtr->flashCells);
967     ckfree((char *) (tablePtr->flashCells));
968     Tcl_DeleteHashTable(tablePtr->selCells);
969     ckfree((char *) (tablePtr->selCells));
970     Tcl_DeleteHashTable(tablePtr->colWidths);
971     ckfree((char *) (tablePtr->colWidths));
972     Tcl_DeleteHashTable(tablePtr->rowHeights);
973     ckfree((char *) (tablePtr->rowHeights));
974 #ifdef PROCS
975     Tcl_DeleteHashTable(tablePtr->inProc);
976     ckfree((char *) (tablePtr->inProc));
977 #endif
978     if (tablePtr->spanTbl) {
979 	Table_ClearHashTable(tablePtr->spanTbl);
980 	ckfree((char *) (tablePtr->spanTbl));
981 	Tcl_DeleteHashTable(tablePtr->spanAffTbl);
982 	ckfree((char *) (tablePtr->spanAffTbl));
983     }
984 
985     /* Now free up all the tag information */
986     for (entryPtr = Tcl_FirstHashEntry(tablePtr->tagTable, &search);
987 	 entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&search)) {
988 	TableCleanupTag(tablePtr, (TableTag *) Tcl_GetHashValue(entryPtr));
989 	ckfree((char *) Tcl_GetHashValue(entryPtr));
990     }
991     /* free up the stuff in the default tag */
992     TableCleanupTag(tablePtr, &(tablePtr->defaultTag));
993     /* And delete the actual hash table */
994     Tcl_DeleteHashTable(tablePtr->tagTable);
995     ckfree((char *) (tablePtr->tagTable));
996     ckfree((char *) (tablePtr->tagPrios));
997     ckfree((char *) (tablePtr->tagPrioNames));
998 
999     /* Now free up all the embedded window info */
1000     for (entryPtr = Tcl_FirstHashEntry(tablePtr->winTable, &search);
1001 	 entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&search)) {
1002 	EmbWinDelete(tablePtr, (TableEmbWindow *) Tcl_GetHashValue(entryPtr));
1003     }
1004     /* And delete the actual hash table */
1005     Tcl_DeleteHashTable(tablePtr->winTable);
1006     ckfree((char *) (tablePtr->winTable));
1007 
1008     /* free the configuration options in the widget */
1009     Tk_FreeOptions(tableSpecs, (char *) tablePtr, tablePtr->display, 0);
1010 
1011     /* and free the widget memory at last! */
1012     ckfree((char *) (tablePtr));
1013 }
1014 
1015 /*
1016  *----------------------------------------------------------------------
1017  *
1018  * TableConfigure --
1019  *	This procedure is called to process an objc/objv list, plus
1020  *	the Tk option database, in order to configure (or reconfigure)
1021  *	a table widget.
1022  *
1023  * Results:
1024  *	The return value is a standard Tcl result.  If TCL_ERROR is
1025  *	returned, then interp result contains an error message.
1026  *
1027  * Side effects:
1028  *	Configuration information, such as colors, border width, etc.
1029  *	get set for tablePtr; old resources get freed, if there were any.
1030  *	Certain values might be constrained.
1031  *
1032  *----------------------------------------------------------------------
1033  */
1034 static int
TableConfigure(interp,tablePtr,objc,objv,flags,forceUpdate)1035 TableConfigure(interp, tablePtr, objc, objv, flags, forceUpdate)
1036      Tcl_Interp *interp;	/* Used for error reporting. */
1037      register Table *tablePtr;	/* Information about widget;  may or may
1038 				 * not already have values for some fields. */
1039      int objc;			/* Number of arguments. */
1040      Tcl_Obj *CONST objv[];	/* Argument objects. */
1041      int flags;			/* Flags to pass to Tk_ConfigureWidget. */
1042      int forceUpdate;		/* Whether to force an update - required
1043 				 * for initial configuration */
1044 {
1045     Tcl_HashSearch search;
1046     int oldUse, oldCaching, oldExport, oldTitleRows, oldTitleCols;
1047     int result = TCL_OK;
1048     Arg *objArray;
1049     Var oldVar = NULL;
1050     Tcl_DString error;
1051     Tk_FontMetrics fm;
1052     char *currentVarString;        /* Name of the current array variable */
1053     char *oldVarString = NULL;     /* Name of the old array variable */
1054 
1055 
1056     oldExport	= tablePtr->exportSelection;
1057     oldCaching	= tablePtr->caching;
1058     oldUse	= tablePtr->useCmd;
1059     oldTitleRows	= tablePtr->titleRows;
1060     oldTitleCols	= tablePtr->titleCols;
1061     if (tablePtr->arrayVar != NULL) {
1062 	oldVar	= tablePtr->arrayVar;
1063         oldVarString = LangString(Tcl_GetVar(interp, oldVar, TCL_GLOBAL_ONLY));
1064     }
1065 
1066 
1067     /* Do the configuration */
1068     /* argv = StringifyObjects(objc, objv); */ /* Don't Need this because arrays of Args like arrays of Obj?? */
1069     objArray = (Tcl_Obj **) objv; /* Cast gets rid of warnings */
1070 
1071     result = Tk_ConfigureWidget(interp, tablePtr->tkwin, tableSpecs,
1072 				objc, objArray, (char *) tablePtr, flags);
1073     /* ckfree((char *) argv); */
1074     if (result != TCL_OK) {
1075 	return TCL_ERROR;
1076     }
1077 
1078     Tcl_DStringInit(&error);
1079 
1080     /* Any time we configure, reevaluate what our data source is */
1081     tablePtr->dataSource = DATA_NONE;
1082     if (tablePtr->caching) {
1083 	tablePtr->dataSource |= DATA_CACHE;
1084     }
1085     if (tablePtr->command && tablePtr->useCmd) {
1086 	tablePtr->dataSource |= DATA_COMMAND;
1087     } else if (tablePtr->arrayVar) {
1088 	tablePtr->dataSource |= DATA_ARRAY;
1089     }
1090 
1091     /* Check to see if the array variable was changed */
1092     currentVarString = LangString(Tcl_GetVar(interp, tablePtr->arrayVar, TCL_GLOBAL_ONLY));
1093 
1094     if (strcmp((currentVarString?currentVarString:""),
1095 	       (oldVarString?oldVarString:""))) {
1096 	/* only do the following if arrayVar is our data source */
1097 	if (tablePtr->dataSource & DATA_ARRAY) {
1098 	    /*
1099 	     * ensure that the cache will flush later
1100 	     * so it gets the new values
1101 	     */
1102 	    oldCaching = !(tablePtr->caching);
1103 	}
1104 	/* remove the trace on the old array variable if there was one */
1105 	if (oldVar != NULL)
1106 	    Tcl_UntraceVar(interp, oldVar,
1107 		    TCL_TRACE_WRITES|TCL_TRACE_UNSETS|TCL_GLOBAL_ONLY,
1108 		    (Tcl_VarTraceProc *)TableVarProc, (ClientData) tablePtr);
1109 	/* Check whether variable is an array and trace it if it is */
1110 	if (tablePtr->arrayVar != NULL) {
1111 	    /* does the variable exist as an array? */
1112 	    if (Tcl_SetVar2(interp, tablePtr->arrayVar, TEST_KEY, "",
1113 		    TCL_GLOBAL_ONLY) == NULL) {
1114 		Tcl_DStringAppend(&error, "invalid variable value \"", -1);
1115 		Tcl_DStringAppend(&error, currentVarString, -1);
1116 		Tcl_DStringAppend(&error, "\": could not be made an array",
1117 			-1);
1118 		ckfree(currentVarString);
1119 		tablePtr->arrayVar = NULL;
1120 		tablePtr->dataSource &= ~DATA_ARRAY;
1121 		result = TCL_ERROR;
1122 	    } else {
1123 
1124 		/* perltk not supported */
1125 		/* Tcl_UnsetVar2(interp, currentVarString, TEST_KEY,
1126 			      TCL_GLOBAL_ONLY); */
1127 		/* remove the effect of the evaluation */
1128 		/* set a trace on the variable */
1129 		Tcl_TraceVar(interp, tablePtr->arrayVar,
1130 			TCL_TRACE_WRITES|TCL_TRACE_UNSETS|TCL_GLOBAL_ONLY,
1131 			(Tcl_VarTraceProc *)TableVarProc,
1132 			(ClientData) tablePtr);
1133 
1134 		/* only do the following if arrayVar is our data source */
1135 		if (tablePtr->dataSource & DATA_ARRAY) {
1136 		    /* get the current value of the selection */
1137 		    TableGetActiveBuf(tablePtr);
1138 		}
1139 	    }
1140 	}
1141     }
1142 
1143     /* Free oldVar if it was allocated */
1144     /* if (oldVar != NULL) ckfree(oldVar); */
1145 
1146     if ((tablePtr->command && tablePtr->useCmd && !oldUse) ||
1147 	(tablePtr->arrayVar && !(tablePtr->useCmd) && oldUse)) {
1148 	/*
1149 	 * Our effective data source changed, so flush and
1150 	 * retrieve new active buffer
1151 	 */
1152 	Table_ClearHashTable(tablePtr->cache);
1153 	Tcl_InitHashTable(tablePtr->cache, TCL_STRING_KEYS);
1154 	TableGetActiveBuf(tablePtr);
1155 	forceUpdate = 1;
1156     } else if (oldCaching != tablePtr->caching) {
1157 	/*
1158 	 * Caching changed, so just clear the cache for safety
1159 	 */
1160 	Table_ClearHashTable(tablePtr->cache);
1161 	Tcl_InitHashTable(tablePtr->cache, TCL_STRING_KEYS);
1162 	forceUpdate = 1;
1163     }
1164 
1165     /*
1166      * Set up the default column width and row height
1167      */
1168     Tk_GetFontMetrics(tablePtr->defaultTag.tkfont, &fm);
1169     tablePtr->charWidth  = Tk_TextWidth(tablePtr->defaultTag.tkfont, "0", 1);
1170     tablePtr->charHeight = fm.linespace + 2;
1171 
1172     if (tablePtr->insertWidth <= 0) {
1173 	tablePtr->insertWidth = 2;
1174     }
1175     if (tablePtr->insertBorderWidth > tablePtr->insertWidth/2) {
1176 	tablePtr->insertBorderWidth = tablePtr->insertWidth/2;
1177     }
1178     tablePtr->highlightWidth = MAX(0,tablePtr->highlightWidth);
1179 
1180     /*
1181      * Ensure that certain values are within proper constraints
1182      */
1183     tablePtr->rows		= MAX(1, tablePtr->rows);
1184     tablePtr->cols		= MAX(1, tablePtr->cols);
1185     tablePtr->padX		= MAX(0, tablePtr->padX);
1186     tablePtr->padY		= MAX(0, tablePtr->padY);
1187     tablePtr->ipadX		= MAX(0, tablePtr->ipadX);
1188     tablePtr->ipadY		= MAX(0, tablePtr->ipadY);
1189     tablePtr->maxReqCols	= MAX(0, tablePtr->maxReqCols);
1190     tablePtr->maxReqRows	= MAX(0, tablePtr->maxReqRows);
1191     CONSTRAIN(tablePtr->titleRows, 0, tablePtr->rows);
1192     CONSTRAIN(tablePtr->titleCols, 0, tablePtr->cols);
1193 
1194     /*
1195      * Handle change of default border style
1196      * The default borderwidth must be >= 0.
1197      */
1198     if (tablePtr->drawMode & (DRAW_MODE_SINGLE|DRAW_MODE_FAST)) {
1199 	/*
1200 	 * When drawing fast or single, the border must be <= 1.
1201 	 * We have to do this after the normal configuration
1202 	 * to base the borders off the first value given.
1203 	 */
1204 	tablePtr->defaultTag.bd[0]	= MIN(1, tablePtr->defaultTag.bd[0]);
1205 	tablePtr->defaultTag.borders	= 1;
1206 	ckfree((char *) tablePtr->defaultTag.borderStr);
1207 	tablePtr->defaultTag.borderStr	= (char *) ckalloc(2);
1208 	strcpy(tablePtr->defaultTag.borderStr,
1209 		tablePtr->defaultTag.bd[0] ? "1" : "0");
1210     }
1211 
1212     /*
1213      * Claim the selection if we've suddenly started exporting it and
1214      * there is a selection to export.
1215      */
1216     if (tablePtr->exportSelection && !oldExport &&
1217 	(Tcl_FirstHashEntry(tablePtr->selCells, &search) != NULL)) {
1218 	Tk_OwnSelection(tablePtr->tkwin, XA_PRIMARY, TableLostSelection,
1219 		(ClientData) tablePtr);
1220     }
1221 
1222     if ((tablePtr->titleRows < oldTitleRows) ||
1223 	(tablePtr->titleCols < oldTitleCols)) {
1224 	/*
1225 	 * Prevent odd movement due to new possible topleft index
1226 	 */
1227 	if (tablePtr->titleRows < oldTitleRows)
1228 	    tablePtr->topRow -= oldTitleRows - tablePtr->titleRows;
1229 	if (tablePtr->titleCols < oldTitleCols)
1230 	    tablePtr->leftCol -= oldTitleCols - tablePtr->titleCols;
1231 	/*
1232 	 * If our title area shrank, we need to check that the items
1233 	 * within the new title area don't try to span outside it.
1234 	 */
1235 	TableSpanSanCheck(tablePtr);
1236     }
1237 
1238     /*
1239      * Only do the full reconfigure if absolutely necessary
1240      */
1241     if (!forceUpdate) {
1242 	int i, dummy;
1243 	for (i = 0; i < objc-1; i += 2) {
1244 	    if (Tcl_GetIndexFromObj(NULL, objv[i], updateOpts, "", 0, &dummy)
1245 		    == TCL_OK) {
1246 		forceUpdate = 1;
1247 		break;
1248 	    }
1249 	}
1250     }
1251     if (forceUpdate) {
1252 	/*
1253 	 * Calculate the row and column starts
1254 	 * Adjust the top left corner of the internal display
1255 	 */
1256 	TableAdjustParams(tablePtr);
1257 	/* reset the cursor */
1258 	TableConfigCursor(tablePtr);
1259 	/* set up the background colour in the window */
1260 	Tk_SetBackgroundFromBorder(tablePtr->tkwin, tablePtr->defaultTag.bg);
1261 	/* set the geometry and border */
1262 	TableGeometryRequest(tablePtr);
1263 	Tk_SetInternalBorder(tablePtr->tkwin, tablePtr->highlightWidth);
1264 	/* invalidate the whole table */
1265 	TableInvalidateAll(tablePtr, INV_HIGHLIGHT);
1266     }
1267     /*
1268      * FIX this is goofy because the result could be munged by other
1269      * functions.  Could be improved.
1270      */
1271     Tcl_ResetResult(interp);
1272     if (result == TCL_ERROR) {
1273 	Tcl_AddErrorInfo(interp, "\t(configuring table widget)");
1274 	Tcl_DStringResult(interp, &error);
1275     }
1276     Tcl_DStringFree(&error);
1277     return result;
1278 }
1279 
1280 /*
1281  *--------------------------------------------------------------
1282  *
1283  * TableEventProc --
1284  *	This procedure is invoked by the Tk dispatcher for various
1285  *	events on tables.
1286  *
1287  * Results:
1288  *	None.
1289  *
1290  * Side effects:
1291  *	When the window gets deleted, internal structures get
1292  *	cleaned up.  When it gets exposed, it is redisplayed.
1293  *
1294  *--------------------------------------------------------------
1295  */
1296 static void
TableEventProc(clientData,eventPtr)1297 TableEventProc(clientData, eventPtr)
1298     ClientData clientData;	/* Information about window. */
1299     XEvent *eventPtr;		/* Information about event. */
1300 {
1301     Table *tablePtr = (Table *) clientData;
1302     int row, col;
1303 
1304     switch (eventPtr->type) {
1305 	case MotionNotify:
1306 	    if (!(tablePtr->resize & SEL_NONE)
1307 		    && (tablePtr->bdcursor != None) &&
1308 		    TableAtBorder(tablePtr, eventPtr->xmotion.x,
1309 			    eventPtr->xmotion.y, &row, &col) &&
1310 		    ((row>=0 && (tablePtr->resize & SEL_ROW)) ||
1311 			    (col>=0 && (tablePtr->resize & SEL_COL)))) {
1312 		/*
1313 		 * The bordercursor is defined and we meet the criteria for
1314 		 * being over a border.  Set the cursor to border if not
1315 		 * already done.
1316 		 */
1317 		if (!(tablePtr->flags & OVER_BORDER)) {
1318 		    tablePtr->flags |= OVER_BORDER;
1319 		    Tk_DefineCursor(tablePtr->tkwin, tablePtr->bdcursor);
1320 		}
1321 	    } else if (tablePtr->flags & OVER_BORDER) {
1322 		tablePtr->flags &= ~OVER_BORDER;
1323 		if (tablePtr->cursor != None) {
1324 		    Tk_DefineCursor(tablePtr->tkwin, tablePtr->cursor);
1325 		} else {
1326 		    Tk_UndefineCursor(tablePtr->tkwin);
1327 		}
1328 #ifdef TITLE_CURSOR
1329 	    } else if (tablePtr->flags & (OVER_BORDER|OVER_TITLE)) {
1330 		Tk_Cursor cursor = tablePtr->cursor;
1331 
1332 		//tablePtr->flags &= ~(OVER_BORDER|OVER_TITLE);
1333 
1334 		if (tablePtr->titleCursor != None) {
1335 		    TableWhatCell(tablePtr, eventPtr->xmotion.x,
1336 			    eventPtr->xmotion.y, &row, &col);
1337 		    if ((row < tablePtr->titleRows) ||
1338 			    (col < tablePtr->titleCols)) {
1339 			if (tablePtr->flags & OVER_TITLE) {
1340 			    break;
1341 			}
1342 			tablePtr->flags |= OVER_TITLE;
1343 			cursor = tablePtr->titleCursor;
1344 		    }
1345 		}
1346 		if (cursor != None) {
1347 		    Tk_DefineCursor(tablePtr->tkwin, cursor);
1348 		} else {
1349 		    Tk_UndefineCursor(tablePtr->tkwin);
1350 		}
1351 	    } else if (tablePtr->titleCursor != None) {
1352 		Tk_Cursor cursor = tablePtr->cursor;
1353 
1354 		TableWhatCell(tablePtr, eventPtr->xmotion.x,
1355 			eventPtr->xmotion.y, &row, &col);
1356 		if ((row < tablePtr->titleRows) ||
1357 			(col < tablePtr->titleCols)) {
1358 		    if (tablePtr->flags & OVER_TITLE) {
1359 			break;
1360 		    }
1361 		    tablePtr->flags |= OVER_TITLE;
1362 		    cursor = tablePtr->titleCursor;
1363 		}
1364 #endif
1365 	    }
1366 	    break;
1367 
1368 	case Expose:
1369 	    TableInvalidate(tablePtr, eventPtr->xexpose.x, eventPtr->xexpose.y,
1370 		    eventPtr->xexpose.width, eventPtr->xexpose.height,
1371 		    INV_HIGHLIGHT);
1372 	    break;
1373 
1374 	case DestroyNotify:
1375 	    /* remove the command from the interpreter */
1376 	    if (tablePtr->tkwin != NULL) {
1377 		tablePtr->tkwin = NULL;
1378 		Tcl_DeleteCommandFromToken(tablePtr->interp,
1379 			tablePtr->widgetCmd);
1380 	    }
1381 
1382 	    /* cancel any pending update or timer */
1383 	    if (tablePtr->flags & REDRAW_PENDING) {
1384 		Tcl_CancelIdleCall(TableDisplay, (ClientData) tablePtr);
1385 		tablePtr->flags &= ~REDRAW_PENDING;
1386 	    }
1387 	    Tcl_DeleteTimerHandler(tablePtr->cursorTimer);
1388 	    Tcl_DeleteTimerHandler(tablePtr->flashTimer);
1389 
1390 	    Tcl_EventuallyFree((ClientData) tablePtr,
1391 		    (Tcl_FreeProc *) TableDestroy);
1392 	    break;
1393 
1394 	case MapNotify: /* redraw table when remapped if it changed */
1395 	    if (tablePtr->flags & REDRAW_ON_MAP) {
1396 		tablePtr->flags &= ~REDRAW_ON_MAP;
1397 		Tcl_Preserve((ClientData) tablePtr);
1398 		TableAdjustParams(tablePtr);
1399 		TableInvalidateAll(tablePtr, INV_HIGHLIGHT);
1400 		Tcl_Release((ClientData) tablePtr);
1401 	    }
1402 	    break;
1403 
1404 	case ConfigureNotify:
1405 	    Tcl_Preserve((ClientData) tablePtr);
1406 	    TableAdjustParams(tablePtr);
1407 	    TableInvalidateAll(tablePtr, INV_HIGHLIGHT);
1408 	    Tcl_Release((ClientData) tablePtr);
1409 	    break;
1410 
1411 	case FocusIn:
1412 	case FocusOut:
1413 	    if (eventPtr->xfocus.detail != NotifyInferior) {
1414 		tablePtr->flags |= REDRAW_BORDER;
1415 		if (eventPtr->type == FocusOut) {
1416 		    tablePtr->flags &= ~HAS_FOCUS;
1417 		} else {
1418 		    tablePtr->flags |= HAS_FOCUS;
1419 		}
1420 		TableRedrawHighlight(tablePtr);
1421 		/* cancel the timer */
1422 		TableConfigCursor(tablePtr);
1423 	    }
1424 	    break;
1425     }
1426 }
1427 
1428 /*
1429  *----------------------------------------------------------------------
1430  *
1431  * TableCmdDeletedProc --
1432  *
1433  *	This procedure is invoked when a widget command is deleted.  If
1434  *	the widget isn't already in the process of being destroyed,
1435  *	this command destroys it.
1436  *
1437  * Results:
1438  *	None.
1439  *
1440  * Side effects:
1441  *	The widget is destroyed.
1442  *
1443  *----------------------------------------------------------------------
1444  */
1445 static void
TableCmdDeletedProc(ClientData clientData)1446 TableCmdDeletedProc(ClientData clientData)
1447 {
1448     Table *tablePtr = (Table *) clientData;
1449     Tk_Window tkwin;
1450 
1451     /*
1452      * This procedure could be invoked either because the window was
1453      * destroyed and the command was then deleted (in which case tkwin
1454      * is NULL) or because the command was deleted, and then this procedure
1455      * destroys the widget.
1456      */
1457 
1458     if (tablePtr->tkwin != NULL) {
1459 	tkwin = tablePtr->tkwin;
1460 	tablePtr->tkwin = NULL;
1461 	Tk_DestroyWindow(tkwin);
1462     }
1463 }
1464 
1465 /*
1466  *----------------------------------------------------------------------
1467  *
1468  * TableRedrawHighlight --
1469  *	Redraws just the highlight for the window
1470  *
1471  * Results:
1472  *	None.
1473  *
1474  * Side effects:
1475  *	None
1476  *
1477  *----------------------------------------------------------------------
1478  */
1479 static void
TableRedrawHighlight(Table * tablePtr)1480 TableRedrawHighlight(Table *tablePtr)
1481 {
1482     if ((tablePtr->flags & REDRAW_BORDER) && tablePtr->highlightWidth > 0) {
1483 	GC gc = Tk_GCForColor((tablePtr->flags & HAS_FOCUS)
1484 		? tablePtr->highlightColorPtr : tablePtr->highlightBgColorPtr,
1485 		Tk_WindowId(tablePtr->tkwin));
1486 	Tk_DrawFocusHighlight(tablePtr->tkwin, gc, tablePtr->highlightWidth,
1487 		Tk_WindowId(tablePtr->tkwin));
1488     }
1489     tablePtr->flags &= ~REDRAW_BORDER;
1490 }
1491 
1492 /*
1493  *----------------------------------------------------------------------
1494  *
1495  * TableRefresh --
1496  *	Refreshes an area of the table based on the mode.
1497  *	row,col in real coords (0-based)
1498  *
1499  * Results:
1500  *	Will cause redraw for visible cells
1501  *
1502  * Side effects:
1503  *	None.
1504  *
1505  *----------------------------------------------------------------------
1506  */
1507 void
TableRefresh(register Table * tablePtr,int row,int col,int mode)1508 TableRefresh(register Table *tablePtr, int row, int col, int mode)
1509 {
1510     int x, y, w, h;
1511 
1512     if ((row < 0) || (col < 0)) {
1513 	/*
1514 	 * Invalid coords passed in.  This can happen when the "active" cell
1515 	 * is refreshed, but doesn't really exist (row==-1 && col==-1).
1516 	 */
1517 	return;
1518     }
1519     if (mode & CELL) {
1520 	if (TableCellVCoords(tablePtr, row, col, &x, &y, &w, &h, 0)) {
1521 	    TableInvalidate(tablePtr, x, y, w, h, mode);
1522 	}
1523     } else if (mode & ROW) {
1524 	/* get the position of the leftmost cell in the row */
1525 	if ((mode & INV_FILL) && row < tablePtr->topRow) {
1526 	    /* Invalidate whole table */
1527 	    TableInvalidateAll(tablePtr, mode);
1528 	} else if (TableCellVCoords(tablePtr, row, tablePtr->leftCol,
1529 		&x, &y, &w, &h, 0)) {
1530 	    /* Invalidate from this row, maybe to end */
1531 	    TableInvalidate(tablePtr, 0, y, Tk_Width(tablePtr->tkwin),
1532 		    (mode&INV_FILL)?Tk_Height(tablePtr->tkwin):h, mode);
1533 	}
1534     } else if (mode & COL) {
1535 	/* get the position of the topmost cell on the column */
1536 	if ((mode & INV_FILL) && col < tablePtr->leftCol) {
1537 	    /* Invalidate whole table */
1538 	    TableInvalidateAll(tablePtr, mode);
1539 	} else if (TableCellVCoords(tablePtr, tablePtr->topRow, col,
1540 		&x, &y, &w, &h, 0)) {
1541 	    /* Invalidate from this column, maybe to end */
1542 	    TableInvalidate(tablePtr, x, 0,
1543 		    (mode&INV_FILL)?Tk_Width(tablePtr->tkwin):w,
1544 		    Tk_Height(tablePtr->tkwin), mode);
1545 	}
1546     }
1547 }
1548 
1549 /*
1550  *----------------------------------------------------------------------
1551  *
1552  * TableGetGc --
1553  *	Gets a GC corresponding to the tag structure passed.
1554  *
1555  * Results:
1556  *	Returns usable GC.
1557  *
1558  * Side effects:
1559  *	None
1560  *
1561  *----------------------------------------------------------------------
1562  */
1563 static void
TableGetGc(Display * display,Drawable d,TableTag * tagPtr,GC * tagGc)1564 TableGetGc(Display *display, Drawable d, TableTag *tagPtr, GC *tagGc)
1565 {
1566     XGCValues gcValues;
1567     gcValues.foreground = Tk_3DBorderColor(tagPtr->fg)->pixel;
1568     gcValues.background = Tk_3DBorderColor(tagPtr->bg)->pixel;
1569     gcValues.font = Tk_FontId(tagPtr->tkfont);
1570     if (*tagGc == NULL) {
1571 	gcValues.graphics_exposures = False;
1572 	*tagGc = XCreateGC(display, d,
1573 		GCForeground|GCBackground|GCFont|GCGraphicsExposures,
1574 		&gcValues);
1575     } else {
1576 	XChangeGC(display, *tagGc, GCForeground|GCBackground|GCFont,
1577 		&gcValues);
1578     }
1579 }
1580 
1581 #define TableFreeGc	XFreeGC
1582 
1583 /*
1584  *--------------------------------------------------------------
1585  *
1586  * TableUndisplay --
1587  *	This procedure removes the contents of a table window
1588  *	that have been moved offscreen.
1589  *
1590  * Results:
1591  *	Embedded windows can be unmapped.
1592  *
1593  * Side effects:
1594  *	Information disappears from the screen.
1595  *
1596  *--------------------------------------------------------------
1597  */
1598 static void
TableUndisplay(register Table * tablePtr)1599 TableUndisplay(register Table *tablePtr)
1600 {
1601     register int *seen = tablePtr->seen;
1602     int row, col;
1603 
1604     /* We need to find out the true last cell, not considering spans */
1605     tablePtr->flags |= AVOID_SPANS;
1606     TableGetLastCell(tablePtr, &row, &col);
1607     tablePtr->flags &= ~AVOID_SPANS;
1608 
1609     if (seen[0] != -1) {
1610 	if (seen[0] < tablePtr->topRow) {
1611 	    /* Remove now hidden rows */
1612 	    EmbWinUnmap(tablePtr, seen[0], MIN(seen[2],tablePtr->topRow-1),
1613 		    seen[1], seen[3]);
1614 	    /* Also account for the title area */
1615 	    EmbWinUnmap(tablePtr, seen[0], MIN(seen[2],tablePtr->topRow-1),
1616 		    0, tablePtr->titleCols-1);
1617 	}
1618 	if (seen[1] < tablePtr->leftCol) {
1619 	    /* Remove now hidden cols */
1620 	    EmbWinUnmap(tablePtr, seen[0], seen[2],
1621 		    seen[1], MAX(seen[3],tablePtr->leftCol-1));
1622 	    /* Also account for the title area */
1623 	    EmbWinUnmap(tablePtr, 0, tablePtr->titleRows-1,
1624 		    seen[1], MAX(seen[3],tablePtr->leftCol-1));
1625 	}
1626 	if (seen[2] > row) {
1627 	    /* Remove now off-screen rows */
1628 	    EmbWinUnmap(tablePtr, MAX(seen[0],row+1), seen[2],
1629 		    seen[1], seen[3]);
1630 	    /* Also account for the title area */
1631 	    EmbWinUnmap(tablePtr, MAX(seen[0],row+1), seen[2],
1632 		    0, tablePtr->titleCols-1);
1633 	}
1634 	if (seen[3] > col) {
1635 	    /* Remove now off-screen cols */
1636 	    EmbWinUnmap(tablePtr, seen[0], seen[2],
1637 		    MAX(seen[1],col+1), seen[3]);
1638 	    /* Also account for the title area */
1639 	    EmbWinUnmap(tablePtr, 0, tablePtr->titleRows-1,
1640 		    MAX(seen[1],col+1), seen[3]);
1641 	}
1642     }
1643     seen[0] = tablePtr->topRow;
1644     seen[1] = tablePtr->leftCol;
1645     seen[2] = row;
1646     seen[3] = col;
1647 }
1648 
1649 #if defined(MAC_TCL) || (defined(WIN32) && defined(TCL_THREADS)) || defined(MAC_OSX_TK)
1650 #define NO_XSETCLIP
1651 #endif
1652 /*
1653  *--------------------------------------------------------------
1654  *
1655  * TableDisplay --
1656  *	This procedure redraws the contents of a table window.
1657  *	The conditional code in this function is due to these factors:
1658  *		o Lack of XSetClipRectangles on Macintosh
1659  *		o Use of alternative routine for Windows
1660  *
1661  * Results:
1662  *	None.
1663  *
1664  * Side effects:
1665  *	Information appears on the screen.
1666  *
1667  *--------------------------------------------------------------
1668  */
1669 static void
TableDisplay(ClientData clientdata)1670 TableDisplay(ClientData clientdata)
1671 {
1672     register Table *tablePtr = (Table *) clientdata;
1673     Tk_Window tkwin = tablePtr->tkwin;
1674     Display *display = tablePtr->display;
1675     Drawable window;
1676 #ifdef NO_XSETCLIP
1677     Drawable clipWind;
1678 #elif !defined(WIN32)
1679     XRectangle clipRect;
1680 #endif
1681     int rowFrom, rowTo, colFrom, colTo,
1682 	invalidX, invalidY, invalidWidth, invalidHeight,
1683 	x, y, width, height, itemX, itemY, itemW, itemH,
1684 	row, col, urow, ucol, hrow=0, hcol=0, cx, cy, cw, ch, borders, bd[6],
1685 	numBytes, new, boundW, boundH, maxW, maxH, cellType,
1686 	originX, originY, activeCell, shouldInvert, ipadx, ipady, padx, pady;
1687     GC tagGc = NULL, topGc, bottomGc;
1688     char *string = NULL;
1689     char buf[INDEX_BUFSIZE];
1690     TableTag *tagPtr = NULL, *titlePtr, *selPtr, *activePtr, *flashPtr,
1691 	*rowPtr, *colPtr;
1692     Tcl_HashEntry *entryPtr;
1693     static XPoint rect[3] = { {0, 0}, {0, 0}, {0, 0} };
1694     Tcl_HashTable *colTagsCache = NULL;
1695     Tcl_HashTable *drawnCache = NULL;
1696     Tk_TextLayout textLayout = NULL;
1697     TableEmbWindow *ewPtr;
1698 
1699     tablePtr->flags &= ~REDRAW_PENDING;
1700     if ((tkwin == NULL) || !Tk_IsMapped(tkwin)) {
1701 	return;
1702     }
1703 
1704     boundW = Tk_Width(tkwin) - tablePtr->highlightWidth;
1705     boundH = Tk_Height(tkwin) - tablePtr->highlightWidth;
1706 
1707     /* Constrain drawable to not include highlight borders */
1708     invalidX = MAX(tablePtr->highlightWidth, tablePtr->invalidX);
1709     invalidY = MAX(tablePtr->highlightWidth, tablePtr->invalidY);
1710     invalidWidth  = MIN(tablePtr->invalidWidth, MAX(1, boundW-invalidX));
1711     invalidHeight = MIN(tablePtr->invalidHeight, MAX(1, boundH-invalidY));
1712 
1713     ipadx = tablePtr->ipadX;
1714     ipady = tablePtr->ipadY;
1715     padx  = tablePtr->padX;
1716     pady  = tablePtr->padY;
1717 
1718     /*
1719      * if we are using the slow drawing mode with a pixmap
1720      * create the pixmap and adjust x && y for offset in pixmap
1721      */
1722     if (tablePtr->drawMode == DRAW_MODE_SLOW) {
1723 	window = Tk_GetPixmap(display, Tk_WindowId(tkwin),
1724 		invalidWidth, invalidHeight, Tk_Depth(tkwin));
1725     } else {
1726 	window = Tk_WindowId(tkwin);
1727     }
1728 #ifdef NO_XSETCLIP
1729     clipWind = Tk_GetPixmap(display, window,
1730 	    invalidWidth, invalidHeight, Tk_Depth(tkwin));
1731 #endif
1732 
1733     /* set up the permanent tag styles */
1734     entryPtr	= Tcl_FindHashEntry(tablePtr->tagTable, "title");
1735     titlePtr	= (TableTag *) Tcl_GetHashValue(entryPtr);
1736     entryPtr	= Tcl_FindHashEntry(tablePtr->tagTable, "sel");
1737     selPtr	= (TableTag *) Tcl_GetHashValue(entryPtr);
1738     entryPtr	= Tcl_FindHashEntry(tablePtr->tagTable, "active");
1739     activePtr	= (TableTag *) Tcl_GetHashValue(entryPtr);
1740     entryPtr	= Tcl_FindHashEntry(tablePtr->tagTable, "flash");
1741     flashPtr	= (TableTag *) Tcl_GetHashValue(entryPtr);
1742 
1743     /* We need to find out the true cell span, not considering spans */
1744     tablePtr->flags |= AVOID_SPANS;
1745     /* find out the cells represented by the invalid region */
1746     TableWhatCell(tablePtr, invalidX, invalidY, &rowFrom, &colFrom);
1747     TableWhatCell(tablePtr, invalidX+invalidWidth-1,
1748 	    invalidY+invalidHeight-1, &rowTo, &colTo);
1749     tablePtr->flags &= ~AVOID_SPANS;
1750 
1751 #ifdef DEBUG
1752     tcl_dprintf(tablePtr->interp, "%d,%d => %d,%d",
1753 	    rowFrom+tablePtr->rowOffset, colFrom+tablePtr->colOffset,
1754 	    rowTo+tablePtr->rowOffset, colTo+tablePtr->colOffset);
1755 #endif
1756 
1757     /*
1758      * Initialize colTagsCache hash table to cache column tag names.
1759      */
1760     colTagsCache = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
1761     Tcl_InitHashTable(colTagsCache, TCL_ONE_WORD_KEYS);
1762     /*
1763      * Initialize drawnCache hash table to cache drawn cells.
1764      * This is necessary to prevent spanning cells being drawn multiple times.
1765      */
1766     drawnCache = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
1767     Tcl_InitHashTable(drawnCache, TCL_STRING_KEYS);
1768 
1769     /*
1770      * Create the tag here.  This will actually create a JoinTag
1771      * That will handle the priority management of merging for us.
1772      * We only need one allocated, and we'll reset it for each cell.
1773      */
1774     tagPtr = TableNewTag(tablePtr);
1775 
1776     /* Cycle through the cells and display them */
1777     for (row = rowFrom; row <= rowTo; row++) {
1778 	/*
1779 	 * are we in the 'dead zone' between the
1780 	 * title rows and the first displayed row
1781 	 */
1782 	if (row < tablePtr->topRow && row >= tablePtr->titleRows) {
1783 	    row = tablePtr->topRow;
1784 	}
1785 
1786 	/* Cache the row in user terms */
1787 	urow = row+tablePtr->rowOffset;
1788 
1789 	/* Get the row tag once for all iterations of col */
1790 	rowPtr = FindRowColTag(tablePtr, urow, ROW);
1791 
1792 	for (col = colFrom; col <= colTo; col++) {
1793 	    activeCell = 0;
1794 	    /*
1795 	     * Adjust to first viewable column if we are in the 'dead zone'
1796 	     * between the title cols and the first displayed column.
1797 	     */
1798 	    if (col < tablePtr->leftCol && col >= tablePtr->titleCols) {
1799 		col = tablePtr->leftCol;
1800 	    }
1801 
1802 	    /*
1803 	     * Get the coordinates for the cell before possible rearrangement
1804 	     * of row,col due to spanning cells
1805 	     */
1806 	    cellType = TableCellCoords(tablePtr, row, col,
1807 		    &x, &y, &width, &height);
1808 	    if (cellType == CELL_HIDDEN) {
1809 		/*
1810 		 * width,height holds the real start row,col of the span.
1811 		 * Put the use cell ref into a buffer for the hash lookups.
1812 		 */
1813 		TableMakeArrayIndex(width, height, buf);
1814 		Tcl_CreateHashEntry(drawnCache, buf, &new);
1815 		if (!new) {
1816 		    /* Not new in the entry, so it's already drawn */
1817 		    continue;
1818 		}
1819 		hrow = row; hcol = col;
1820 		row = width-tablePtr->rowOffset;
1821 		col = height-tablePtr->colOffset;
1822 		TableCellVCoords(tablePtr, row, col,
1823 			&x, &y, &width, &height, 0);
1824 		/* We have to adjust the coords back onto the visual display */
1825 		urow = row+tablePtr->rowOffset;
1826 		rowPtr = FindRowColTag(tablePtr, urow, ROW);
1827 	    }
1828 
1829 	    /* Constrain drawn size to the visual boundaries */
1830 	    if (width > boundW-x)	{ width  = boundW-x; }
1831 	    if (height > boundH-y)	{ height = boundH-y; }
1832 
1833 	    /* Cache the col in user terms */
1834 	    ucol = col+tablePtr->colOffset;
1835 
1836 	    /* put the use cell ref into a buffer for the hash lookups */
1837 	    TableMakeArrayIndex(urow, ucol, buf);
1838 	    if (cellType != CELL_HIDDEN) {
1839 		Tcl_CreateHashEntry(drawnCache, buf, &new);
1840 	    }
1841 
1842 	    /*
1843 	     * Make sure we start with a clean tag (set to table defaults).
1844 	     */
1845 	    TableResetTag(tablePtr, tagPtr);
1846 
1847 	    /*
1848 	     * Check to see if we have an embedded window in this cell.
1849 	     */
1850 	    entryPtr = Tcl_FindHashEntry(tablePtr->winTable, buf);
1851 	    if (entryPtr != NULL) {
1852 		ewPtr = (TableEmbWindow *) Tcl_GetHashValue(entryPtr);
1853 
1854 		if (ewPtr->tkwin != NULL) {
1855 		    /* Display embedded window instead of text */
1856 
1857 		    /* if active, make it disabled to avoid
1858 		     * unnecessary editing */
1859 		    if ((tablePtr->flags & HAS_ACTIVE)
1860 			    && row == tablePtr->activeRow
1861 			    && col == tablePtr->activeCol) {
1862 			tablePtr->flags |= ACTIVE_DISABLED;
1863 		    }
1864 
1865 		    /*
1866 		     * The EmbWinDisplay function may modify values in
1867 		     * tagPtr, so reference those after this call.
1868 		     */
1869 		    EmbWinDisplay(tablePtr, window, ewPtr, tagPtr,
1870 			    x, y, width, height);
1871 
1872 		    if (tablePtr->drawMode == DRAW_MODE_SLOW) {
1873 			/* Correctly adjust x && y with the offset */
1874 			x -= invalidX;
1875 			y -= invalidY;
1876 		    }
1877 
1878 		    Tk_Fill3DRectangle(tkwin, window, tagPtr->bg, x, y, width,
1879 			    height, 0, TK_RELIEF_FLAT);
1880 
1881 		    /* border width for cell should now be properly set */
1882 		    borders = TableGetTagBorders(tagPtr, &bd[0], &bd[1],
1883 			    &bd[2], &bd[3]);
1884 		    bd[4] = (bd[0] + bd[1])/2;
1885 		    bd[5] = (bd[2] + bd[3])/2;
1886 
1887 		    goto DrawBorder;
1888 		}
1889 	    }
1890 
1891 	    if (tablePtr->drawMode == DRAW_MODE_SLOW) {
1892 		/* Correctly adjust x && y with the offset */
1893 		x -= invalidX;
1894 		y -= invalidY;
1895 	    }
1896 
1897 	    shouldInvert = 0;
1898 	    /*
1899 	     * Get the combined tag structure for the cell.
1900 	     * First clear out a new tag structure that we will build in
1901 	     * then add tags as we realize they belong.
1902 	     *
1903 	     * Tags have their own priorities which TableMergeTag will
1904 	     * take into account when merging tags.
1905 	     */
1906 
1907 	    /*
1908 	     * Merge colPtr if it exists
1909 	     * let's see if we have the value cached already
1910 	     * if not, run the findColTag routine and cache the value
1911 	     */
1912 	    entryPtr = Tcl_CreateHashEntry(colTagsCache, (char *)ucol, &new);
1913 	    if (new) {
1914 		colPtr = FindRowColTag(tablePtr, ucol, COL);
1915 		Tcl_SetHashValue(entryPtr, colPtr);
1916 	    } else {
1917 		colPtr = (TableTag *) Tcl_GetHashValue(entryPtr);
1918 	    }
1919 	    if (colPtr != (TableTag *) NULL) {
1920 		TableMergeTag(tablePtr, tagPtr, colPtr);
1921 	    }
1922 	    /* Merge rowPtr if it exists */
1923 	    if (rowPtr != (TableTag *) NULL) {
1924 		TableMergeTag(tablePtr, tagPtr, rowPtr);
1925 	    }
1926 	    /* Am I in the titles */
1927 	    if (row < tablePtr->titleRows || col < tablePtr->titleCols) {
1928 		TableMergeTag(tablePtr, tagPtr, titlePtr);
1929 	    }
1930 	    /* Does this have a cell tag */
1931 	    entryPtr = Tcl_FindHashEntry(tablePtr->cellStyles, buf);
1932 	    if (entryPtr != NULL) {
1933 		TableMergeTag(tablePtr, tagPtr,
1934 			(TableTag *) Tcl_GetHashValue(entryPtr));
1935 	    }
1936 	    /* is this cell active? */
1937 	    if ((tablePtr->flags & HAS_ACTIVE) &&
1938 		    (tablePtr->state == STATE_NORMAL) &&
1939 		    row == tablePtr->activeRow && col == tablePtr->activeCol) {
1940 		if (tagPtr->state == STATE_DISABLED) {
1941 		    tablePtr->flags |= ACTIVE_DISABLED;
1942 		} else {
1943 		    TableMergeTag(tablePtr, tagPtr, activePtr);
1944 		    activeCell = 1;
1945 		    tablePtr->flags &= ~ACTIVE_DISABLED;
1946 		}
1947 	    }
1948 	    /* is this cell selected? */
1949 	    if (Tcl_FindHashEntry(tablePtr->selCells, buf) != NULL) {
1950 		if (tablePtr->invertSelected && !activeCell) {
1951 		    shouldInvert = 1;
1952 		} else {
1953 		    TableMergeTag(tablePtr, tagPtr, selPtr);
1954 		}
1955 	    }
1956 	    /* if flash mode is on, is this cell flashing? */
1957 	    if (tablePtr->flashMode &&
1958 		    Tcl_FindHashEntry(tablePtr->flashCells, buf) != NULL) {
1959 		TableMergeTag(tablePtr, tagPtr, flashPtr);
1960 	    }
1961 
1962 	    if (shouldInvert) {
1963 		TableInvertTag(tagPtr);
1964 	    }
1965 
1966 	    /*
1967 	     * Borders for cell should now be properly set
1968 	     */
1969 	    borders = TableGetTagBorders(tagPtr, &bd[0], &bd[1],
1970 		    &bd[2], &bd[3]);
1971 	    bd[4] = (bd[0] + bd[1])/2;
1972 	    bd[5] = (bd[2] + bd[3])/2;
1973 
1974 	    /*
1975 	     * First fill in a blank rectangle.
1976 	     */
1977 	    Tk_Fill3DRectangle(tkwin, window, tagPtr->bg,
1978 		    x, y, width, height, 0, TK_RELIEF_FLAT);
1979 
1980 	    /*
1981 	     * Correct the dimensions to enforce padding constraints
1982 	     */
1983 	    width  -= bd[0] + bd[1] + (2 * padx);
1984 	    height -= bd[2] + bd[3] + (2 * pady);
1985 
1986 	    /*
1987 	     * If an image is in the tag, draw it
1988 	     */
1989 	    if (tagPtr->image != NULL) {
1990 		Tk_SizeOfImage(tagPtr->image, &itemW, &itemH);
1991 		/* Handle anchoring of image in cell space */
1992 		switch (tagPtr->anchor) {
1993 		    case TK_ANCHOR_NW:
1994 		    case TK_ANCHOR_W:
1995 		    case TK_ANCHOR_SW:		/* western position */
1996 			originX = itemX = 0;
1997 			break;
1998 		    case TK_ANCHOR_N:
1999 		    case TK_ANCHOR_S:
2000 		    case TK_ANCHOR_CENTER:	/* centered position */
2001 			itemX	= MAX(0, (itemW - width) / 2);
2002 			originX	= MAX(0, (width - itemW) / 2);
2003 			break;
2004 		    default:			/* eastern position */
2005 			itemX	= MAX(0, itemW - width);
2006 			originX	= MAX(0, width - itemW);
2007 		}
2008 		switch (tagPtr->anchor) {
2009 		    case TK_ANCHOR_N:
2010 		    case TK_ANCHOR_NE:
2011 		    case TK_ANCHOR_NW:		/* northern position */
2012 			originY = itemY = 0;
2013 			break;
2014 		    case TK_ANCHOR_W:
2015 		    case TK_ANCHOR_E:
2016 		    case TK_ANCHOR_CENTER:	/* centered position */
2017 			itemY	= MAX(0, (itemH - height) / 2);
2018 			originY	= MAX(0, (height - itemH) / 2);
2019 			break;
2020 		    default:			/* southern position */
2021 			itemY	= MAX(0, itemH - height);
2022 			originY	= MAX(0, height - itemH);
2023 		}
2024 		Tk_RedrawImage(tagPtr->image, itemX, itemY,
2025 			MIN(itemW, width-originX), MIN(itemH, height-originY),
2026 			window, x + originX + bd[0] + padx,
2027 			y + originY + bd[2] + pady);
2028 		/*
2029 		 * If we don't want to display the text as well, then jump.
2030 		 */
2031 		if (tagPtr->showtext == 0) {
2032 		    /*
2033 		     * Re-Correct the dimensions before border drawing
2034 		     */
2035 		    width  += bd[0] + bd[1] + (2 * padx);
2036 		    height += bd[2] + bd[3] + (2 * pady);
2037 		    goto DrawBorder;
2038 		}
2039 	    }
2040 
2041 	    /*
2042 	     * Get the GC for this particular blend of tags.
2043 	     * This creates the GC if it never existed, otherwise it
2044 	     * modifies the one we have, so we only need the one
2045 	     */
2046 	    TableGetGc(display, window, tagPtr, &tagGc);
2047 
2048 	    /* if this is the active cell, use the buffer */
2049 	    if (activeCell) {
2050 		string = tablePtr->activeBuf;
2051 	    } else {
2052 		/* Is there a value in the cell? If so, draw it  */
2053 		string = TableGetCellValue(tablePtr, urow, ucol);
2054 	    }
2055 
2056 #ifdef TCL_UTF_MAX
2057 	    /*
2058 	     * We have to use strlen here because otherwise it stops
2059 	     * at the first \x00 unicode char it finds (!= '\0'),
2060 	     * although there can be more to the string than that
2061 	     */
2062 	    numBytes = Tcl_NumUtfChars(string, strlen(string));
2063 #else
2064 	    numBytes = strlen(string);
2065 #endif
2066 
2067 	    /* If there is a string, show it */
2068 	    if (activeCell || numBytes) {
2069 		/* get the dimensions of the string */
2070 		textLayout = Tk_ComputeTextLayout(tagPtr->tkfont,
2071 			string, numBytes,
2072 			(tagPtr->wrap > 0) ? width : 0, tagPtr->justify,
2073 			(tagPtr->multiline > 0) ? 0 : TK_IGNORE_NEWLINES,
2074 			&itemW, &itemH);
2075 
2076 		/*
2077 		 * Set the origin coordinates of the string to draw using
2078 		 * the anchor.  origin represents the (x,y) coordinate of
2079 		 * the lower left corner of the text box, relative to the
2080 		 * internal (inside the border) window
2081 		 */
2082 
2083 		/* set the X origin first */
2084 		switch (tagPtr->anchor) {
2085 		    case TK_ANCHOR_NW:
2086 		    case TK_ANCHOR_W:
2087 		    case TK_ANCHOR_SW:		/* western position */
2088 			originX = ipadx;
2089 			break;
2090 		    case TK_ANCHOR_N:
2091 		    case TK_ANCHOR_S:
2092 		    case TK_ANCHOR_CENTER:	/* centered position */
2093 			originX = (width - itemW) / 2;
2094 			break;
2095 		    default:			/* eastern position */
2096 			originX = width - itemW - ipadx;
2097 		}
2098 
2099 		/* then set the Y origin */
2100 		switch (tagPtr->anchor) {
2101 		    case TK_ANCHOR_N:
2102 		    case TK_ANCHOR_NE:
2103 		    case TK_ANCHOR_NW:		/* northern position */
2104 			originY = ipady;
2105 			break;
2106 		    case TK_ANCHOR_W:
2107 		    case TK_ANCHOR_E:
2108 		    case TK_ANCHOR_CENTER:	/* centered position */
2109 			originY = (height - itemH) / 2;
2110 			break;
2111 		    default:			/* southern position */
2112 			originY = height - itemH - ipady;
2113 		}
2114 
2115 		/*
2116 		 * If this is the active cell and we are editing,
2117 		 * ensure that the cursor will be displayed
2118 		 */
2119 		if (activeCell) {
2120 		    Tk_CharBbox(textLayout, tablePtr->icursor,
2121 			    &cx, &cy, &cw, &ch);
2122 		    /* we have to fudge with maxW because of odd width
2123 		     * determination for newlines at the end of a line */
2124 		    maxW = width - tablePtr->insertWidth
2125 			- (cx + MIN(tablePtr->charWidth, cw));
2126 		    maxH = height - (cy + ch);
2127 		    if (originX < bd[0] - cx) {
2128 			/* cursor off cell to the left */
2129 			/* use western positioning to cet cursor at left
2130 			 * with slight variation to show some text */
2131 			originX = bd[0] - cx
2132 			    + MIN(cx, width - tablePtr->insertWidth);
2133 		    } else if (originX > maxW) {
2134 			/* cursor off cell to the right */
2135 			/* use eastern positioning to cet cursor at right */
2136 			originX = maxW;
2137 		    }
2138 		    if (originY < bd[2] - cy) {
2139 			/* cursor before top of cell */
2140 			/* use northern positioning to cet cursor at top */
2141 			originY = bd[2] - cy;
2142 		    } else if (originY > maxH) {
2143 			/* cursor beyond bottom of cell */
2144 			/* use southern positioning to cet cursor at bottom */
2145 			originY = maxH;
2146 		    }
2147 		    tablePtr->activeTagPtr	= tagPtr;
2148 		    tablePtr->activeX		= originX;
2149 		    tablePtr->activeY		= originY;
2150 		}
2151 
2152 		/*
2153 		 * Use a clip rectangle only if necessary as it means
2154 		 * updating the GC in the server which slows everything down.
2155 		 * We can't fudge the width or height, just in case the user
2156 		 * wanted empty pad space.
2157 		 */
2158 		if ((originX < 0) || (originY < 0) ||
2159 			(originX+itemW > width) || (originY+itemH > height)) {
2160 		    /*
2161 		     * The text wants to overflow the boundaries of the
2162 		     * displayed cell, so we must clip in some way
2163 		     */
2164 #ifdef NO_XSETCLIP
2165 		    /*
2166 		     * This code is basically for the Macintosh.
2167 		     * Copy the the current contents of the cell into the
2168 		     * clipped window area.  This keeps any fg/bg and image
2169 		     * data intact.
2170 		     */
2171 		    XCopyArea(display, window, clipWind, tagGc, x, y,
2172 			    width + bd[0] + bd[1] + (2 * padx),
2173 			    height + bd[2] + bd[3] + (2 * pady), 0, 0);
2174 		    /*
2175 		     * Now draw into the cell space on the special window.
2176 		     * Don't use x,y base offset for clipWind.
2177 		     */
2178 		    Tk_DrawTextLayout(display, clipWind, tagGc, textLayout,
2179 			    0 + originX + bd[0] + padx,
2180 			    0 + originY + bd[2] + pady, 0, -1);
2181 		    /*
2182 		     * Now copy back only the area that we want the
2183 		     * text to be drawn on.
2184 		     */
2185 		    XCopyArea(display, clipWind, window, tagGc,
2186 			    bd[0] + padx, bd[2] + pady,
2187 			    width, height, x + bd[0] + padx, y + bd[2] + pady);
2188 #elif defined(WIN32)
2189 		    /*
2190 		     * This is evil, evil evil! but the XCopyArea
2191 		     * doesn't work in all cases - Michael Teske.
2192 		     * The general structure follows the comments below.
2193 		     */
2194 		    TkWinDrawable *twdPtr = (TkWinDrawable *) window;
2195 		    HDC dc = GetDC(twdPtr->window.handle);
2196 		    HRGN clipR;
2197 
2198 		    clipR = CreateRectRgn(x + bd[0] + padx, y + bd[2] + pady,
2199 			    x + bd[0] + padx + width,
2200 			    y + bd[2] + pady + height);
2201 
2202 		    SelectClipRgn(dc, clipR);
2203 		    OffsetClipRgn(dc, 0, 0);
2204 
2205 		    Tk_DrawTextLayout(display, window, tagGc, textLayout,
2206 			    x + originX + bd[0] + padx,
2207 			    y + originY + bd[2] + pady, 0, -1);
2208 
2209 		    SelectClipRgn(dc, NULL);
2210 		    DeleteObject(clipR);
2211 #else
2212 		    /*
2213 		     * Use an X clipping rectangle.  The clipping is the
2214 		     * rectangle just for the actual text space (to allow
2215 		     * for empty padding space).
2216 		     */
2217 		    clipRect.x = x + bd[0] + padx;
2218 		    clipRect.y = y + bd[2] + pady;
2219 		    clipRect.width = width;
2220 		    clipRect.height = height;
2221 		    XSetClipRectangles(display, tagGc, 0, 0, &clipRect, 1,
2222 			    Unsorted);
2223 		    Tk_DrawTextLayout(display, window, tagGc, textLayout,
2224 			    x + originX + bd[0] + padx,
2225 			    y + originY + bd[2] + pady, 0, -1);
2226 		    XSetClipMask(display, tagGc, None);
2227 #endif
2228 		} else {
2229 		    Tk_DrawTextLayout(display, window, tagGc, textLayout,
2230 			    x + originX + bd[0] + padx,
2231 			    y + originY + bd[2] + pady, 0, -1);
2232 		}
2233 
2234 		/* if this is the active cell draw the cursor if it's on.
2235 		 * this ignores clip rectangles. */
2236 		if (activeCell && (tablePtr->flags & CURSOR_ON) &&
2237 			(originY + cy + bd[2] + pady < height) &&
2238 			(originX + cx + bd[0] + padx -
2239 				(tablePtr->insertWidth / 2) >= 0)) {
2240 		    /* make sure it will fit in the box */
2241 		    maxW = MAX(0, originY + cy + bd[2] + pady);
2242 		    maxH = MIN(ch, height - maxW + bd[2] + pady);
2243 		    Tk_Fill3DRectangle(tkwin, window, tablePtr->insertBg,
2244 			    x + originX + cx + bd[0] + padx
2245 			    - (tablePtr->insertWidth/2),
2246 			    y + maxW, tablePtr->insertWidth,
2247 			    maxH, 0, TK_RELIEF_FLAT);
2248 		}
2249 	    }
2250 
2251 	    /*
2252 	     * Re-Correct the dimensions before border drawing
2253 	     */
2254 	    width  += bd[0] + bd[1] + (2 * padx);
2255 	    height += bd[2] + bd[3] + (2 * pady);
2256 
2257 	    DrawBorder:
2258 	    /* Draw the 3d border on the pixmap correctly offset */
2259 	    if (tablePtr->drawMode == DRAW_MODE_SINGLE) {
2260 		topGc = Tk_3DBorderGC(tkwin, tagPtr->bg, TK_3D_DARK_GC);
2261 		/* draw a line with single pixel width */
2262 		rect[0].x = x;
2263 		rect[0].y = y + height - 1;
2264 		rect[1].y = -height + 1;
2265 		rect[2].x = width - 1;
2266 		XDrawLines(display, window, topGc, rect, 3, CoordModePrevious);
2267 	    } else if (tablePtr->drawMode == DRAW_MODE_FAST) {
2268 		/*
2269 		 * This depicts a full 1 pixel border.
2270 		 *
2271 		 * Choose the GCs to get the best approximation
2272 		 * to the desired drawing style.
2273 		 */
2274 		switch(tagPtr->relief) {
2275 		    case TK_RELIEF_FLAT:
2276 			topGc = bottomGc = Tk_3DBorderGC(tkwin, tagPtr->bg,
2277 				TK_3D_FLAT_GC);
2278 			break;
2279 		    case TK_RELIEF_RAISED:
2280 		    case TK_RELIEF_RIDGE:
2281 			topGc    = Tk_3DBorderGC(tkwin, tagPtr->bg,
2282 				TK_3D_LIGHT_GC);
2283 			bottomGc = Tk_3DBorderGC(tkwin, tagPtr->bg,
2284 				TK_3D_DARK_GC);
2285 			break;
2286 		    default: /* TK_RELIEF_SUNKEN TK_RELIEF_GROOVE */
2287 			bottomGc = Tk_3DBorderGC(tkwin, tagPtr->bg,
2288 				TK_3D_LIGHT_GC);
2289 			topGc    = Tk_3DBorderGC(tkwin, tagPtr->bg,
2290 				TK_3D_DARK_GC);
2291 			break;
2292 		}
2293 
2294 		/* draw a line with single pixel width */
2295 		rect[0].x = x + width - 1;
2296 		rect[0].y = y;
2297 		rect[1].y = height - 1;
2298 		rect[2].x = -width + 1;
2299 		XDrawLines(display, window, bottomGc, rect, 3,
2300 			CoordModePrevious);
2301 		rect[0].x = x;
2302 		rect[0].y = y + height - 1;
2303 		rect[1].y = -height + 1;
2304 		rect[2].x = width - 1;
2305 		XDrawLines(display, window, topGc, rect, 3,
2306 			CoordModePrevious);
2307 	    } else {
2308 		if (borders > 1) {
2309 		    if (bd[0]) {
2310 			Tk_3DVerticalBevel(tkwin, window, tagPtr->bg,
2311 				x, y, bd[0], height,
2312 				1 /* left side */, tagPtr->relief);
2313 		    }
2314 		    if (bd[1]) {
2315 			Tk_3DVerticalBevel(tkwin, window, tagPtr->bg,
2316 				x + width - bd[1], y, bd[1], height,
2317 				0 /* right side */, tagPtr->relief);
2318 		    }
2319 		    if ((borders == 4) && bd[2]) {
2320 			Tk_3DHorizontalBevel(tkwin, window, tagPtr->bg,
2321 				x, y, width, bd[2],
2322 				1, 1, 1 /* top */, tagPtr->relief);
2323 		    }
2324 		    if ((borders == 4) && bd[3]) {
2325 			Tk_3DHorizontalBevel(tkwin, window, tagPtr->bg,
2326 				x, y + height - bd[3], width, bd[3],
2327 				0, 0, 0 /* bottom */, tagPtr->relief);
2328 		    }
2329 		} else if (borders == 1) {
2330 		    Tk_Draw3DRectangle(tkwin, window, tagPtr->bg, x, y,
2331 			    width, height, bd[0], tagPtr->relief);
2332 		}
2333 	    }
2334 
2335 	    /* clean up the necessaries */
2336 	    if (tagPtr == tablePtr->activeTagPtr) {
2337 		/*
2338 		 * This means it was the activeCell with text displayed.
2339 		 * We buffer the active tag for the 'activate' command.
2340 		 */
2341 		tablePtr->activeTagPtr = TableNewTag(NULL);
2342 		memcpy((VOID *) tablePtr->activeTagPtr,
2343 			(VOID *) tagPtr, sizeof(TableTag));
2344 	    }
2345 	    if (textLayout) {
2346 		Tk_FreeTextLayout(textLayout);
2347 		textLayout = NULL;
2348 	    }
2349 	    if (cellType == CELL_HIDDEN) {
2350 		/* the last cell was a hidden one,
2351 		 * rework row stuff back to normal */
2352 		row = hrow; col = hcol;
2353 		urow = row+tablePtr->rowOffset;
2354 		rowPtr = FindRowColTag(tablePtr, urow, ROW);
2355 	    }
2356 	}
2357     }
2358     ckfree((char *) tagPtr);
2359 #ifdef NO_XSETCLIP
2360     Tk_FreePixmap(display, clipWind);
2361 #endif
2362 
2363     /* Take care of removing embedded windows that are no longer in view */
2364     TableUndisplay(tablePtr);
2365 
2366     /* copy over and delete the pixmap if we are in slow mode */
2367     if (tablePtr->drawMode == DRAW_MODE_SLOW) {
2368 	/* Get a default valued GC */
2369 	TableGetGc(display, window, &(tablePtr->defaultTag), &tagGc);
2370 	XCopyArea(display, window, Tk_WindowId(tkwin), tagGc, 0, 0,
2371 		invalidWidth, invalidHeight, invalidX, invalidY);
2372 	Tk_FreePixmap(display, window);
2373 	window = Tk_WindowId(tkwin);
2374     }
2375 
2376     /*
2377      * If we are at the end of the table, clear the area after the last
2378      * row/col.  We discount spans here because we just need the coords
2379      * for the area that would be the last physical cell.
2380      */
2381     tablePtr->flags |= AVOID_SPANS;
2382     TableCellCoords(tablePtr, tablePtr->rows-1, tablePtr->cols-1,
2383 	    &x, &y, &width, &height);
2384     tablePtr->flags &= ~AVOID_SPANS;
2385 
2386     /* This should occur before moving pixmap, but this simplifies things
2387      *
2388      * Could use Tk_Fill3DRectangle instead of XFillRectangle
2389      * for best compatibility, and XClearArea could be used on Unix
2390      * for best speed, so this is the compromise w/o #ifdef's
2391      */
2392     if (x+width < invalidX+invalidWidth) {
2393 	XFillRectangle(display, window,
2394 		Tk_3DBorderGC(tkwin, tablePtr->defaultTag.bg,
2395 			TK_3D_FLAT_GC), x+width, invalidY,
2396 		invalidX+invalidWidth-x-width, invalidHeight);
2397     }
2398 
2399     if (y+height < invalidY+invalidHeight) {
2400 	XFillRectangle(display, window,
2401 		Tk_3DBorderGC(tkwin, tablePtr->defaultTag.bg,
2402 			TK_3D_FLAT_GC), invalidX, y+height,
2403 		invalidWidth, invalidY+invalidHeight-y-height);
2404     }
2405 
2406     if (tagGc != NULL) {
2407 	TableFreeGc(display, tagGc);
2408     }
2409     TableRedrawHighlight(tablePtr);
2410     /*
2411      * Free the hash table used to cache evaluations.
2412      */
2413     Tcl_DeleteHashTable(colTagsCache);
2414     ckfree((char *) (colTagsCache));
2415     Tcl_DeleteHashTable(drawnCache);
2416     ckfree((char *) (drawnCache));
2417 }
2418 
2419 /*
2420  *----------------------------------------------------------------------
2421  *
2422  * TableInvalidate --
2423  *	Invalidates a rectangle and adds it to the total invalid rectangle
2424  *	waiting to be redrawn.  If the INV_FORCE flag bit is set,
2425  *	it does an update instantly else waits until Tk is idle.
2426  *
2427  * Results:
2428  *	Will schedule table (re)display.
2429  *
2430  * Side effects:
2431  *	None
2432  *
2433  *----------------------------------------------------------------------
2434  */
2435 void
TableInvalidate(Table * tablePtr,int x,int y,int w,int h,int flags)2436 TableInvalidate(Table * tablePtr, int x, int y,
2437 		int w, int h, int flags)
2438 {
2439     Tk_Window tkwin = tablePtr->tkwin;
2440     int hl	= tablePtr->highlightWidth;
2441     int height	= Tk_Height(tkwin);
2442     int width	= Tk_Width(tkwin);
2443 
2444     /*
2445      * Make sure that the window hasn't been destroyed already.
2446      * Avoid allocating 0 sized pixmaps which would be fatal,
2447      * and check if rectangle is even on the screen.
2448      */
2449     if ((tkwin == NULL)
2450 	    || (w <= 0) || (h <= 0) || (x > width) || (y > height)) {
2451 	return;
2452     }
2453 
2454     /* If not even mapped, wait for the remap to redraw all */
2455     if (!Tk_IsMapped(tkwin)) {
2456 	tablePtr->flags |= REDRAW_ON_MAP;
2457 	return;
2458     }
2459 
2460     /*
2461      * If no pending updates exist, then replace the rectangle.
2462      * Otherwise find the bounding rectangle.
2463      */
2464     if ((flags & INV_HIGHLIGHT) &&
2465 	    (x < hl || y < hl || x+w >= width-hl || y+h >= height-hl)) {
2466 	tablePtr->flags |= REDRAW_BORDER;
2467     }
2468 
2469     if (tablePtr->flags & REDRAW_PENDING) {
2470 	tablePtr->invalidWidth = MAX(x + w,
2471 		tablePtr->invalidX+tablePtr->invalidWidth);
2472 	tablePtr->invalidHeight = MAX(y + h,
2473 		tablePtr->invalidY+tablePtr->invalidHeight);
2474 	if (tablePtr->invalidX > x) tablePtr->invalidX = x;
2475 	if (tablePtr->invalidY > y) tablePtr->invalidY = y;
2476 	tablePtr->invalidWidth  -= tablePtr->invalidX;
2477 	tablePtr->invalidHeight -= tablePtr->invalidY;
2478 	/* Do we want to force this update out? */
2479 	if (flags & INV_FORCE) {
2480 	    Tcl_CancelIdleCall(TableDisplay, (ClientData) tablePtr);
2481 	    TableDisplay((ClientData) tablePtr);
2482 	}
2483     } else {
2484 	tablePtr->invalidX = x;
2485 	tablePtr->invalidY = y;
2486 	tablePtr->invalidWidth = w;
2487 	tablePtr->invalidHeight = h;
2488 	if (flags & INV_FORCE) {
2489 	    TableDisplay((ClientData) tablePtr);
2490 	} else {
2491 	    tablePtr->flags |= REDRAW_PENDING;
2492 	    Tcl_DoWhenIdle(TableDisplay, (ClientData) tablePtr);
2493 	}
2494     }
2495 }
2496 
2497 /*
2498  *----------------------------------------------------------------------
2499  *
2500  * TableFlashEvent --
2501  *	Called when the flash timer goes off.
2502  *
2503  * Results:
2504  *	Decrements all the entries in the hash table and invalidates
2505  *	any cells that expire, deleting them from the table.  If the
2506  *	table is now empty, stops the timer, else reenables it.
2507  *
2508  * Side effects:
2509  *	None.
2510  *
2511  *----------------------------------------------------------------------
2512  */
2513 static void
TableFlashEvent(ClientData clientdata)2514 TableFlashEvent(ClientData clientdata)
2515 {
2516     Table *tablePtr = (Table *) clientdata;
2517     Tcl_HashEntry *entryPtr;
2518     Tcl_HashSearch search;
2519     int entries, count, row, col;
2520 
2521     entries = 0;
2522     for (entryPtr = Tcl_FirstHashEntry(tablePtr->flashCells, &search);
2523 	 entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&search)) {
2524 	count = (int) Tcl_GetHashValue(entryPtr);
2525 	if (--count <= 0) {
2526 	    /* get the cell address and invalidate that region only */
2527 	    TableParseArrayIndex(&row, &col,
2528 		    Tcl_GetHashKey(tablePtr->flashCells, entryPtr));
2529 
2530 	    /* delete the entry from the table */
2531 	    Tcl_DeleteHashEntry(entryPtr);
2532 
2533 	    TableRefresh(tablePtr, row-tablePtr->rowOffset,
2534 		    col-tablePtr->colOffset, CELL);
2535 	} else {
2536 	    Tcl_SetHashValue(entryPtr, (ClientData) count);
2537 	    entries++;
2538 	}
2539     }
2540 
2541     /* do I need to restart the timer */
2542     if (entries && tablePtr->flashMode) {
2543 	tablePtr->flashTimer = Tcl_CreateTimerHandler(250, TableFlashEvent,
2544 		(ClientData) tablePtr);
2545     } else {
2546 	tablePtr->flashTimer = 0;
2547     }
2548 }
2549 
2550 /*
2551  *----------------------------------------------------------------------
2552  *
2553  * TableAddFlash --
2554  *	Adds a flash on cell row,col (real coords) with the default timeout
2555  *	if flashing is enabled and flashtime > 0.
2556  *
2557  * Results:
2558  *	Cell will flash.
2559  *
2560  * Side effects:
2561  *	Will start flash timer if it didn't exist.
2562  *
2563  *----------------------------------------------------------------------
2564  */
2565 void
TableAddFlash(Table * tablePtr,int row,int col)2566 TableAddFlash(Table *tablePtr, int row, int col)
2567 {
2568     char buf[INDEX_BUFSIZE];
2569     int dummy;
2570     Tcl_HashEntry *entryPtr;
2571 
2572     if (!tablePtr->flashMode || tablePtr->flashTime < 1) {
2573 	return;
2574     }
2575 
2576     /* create the array index in user coords */
2577     TableMakeArrayIndex(row+tablePtr->rowOffset, col+tablePtr->colOffset, buf);
2578 
2579     /* add the flash to the hash table */
2580     entryPtr = Tcl_CreateHashEntry(tablePtr->flashCells, buf, &dummy);
2581     Tcl_SetHashValue(entryPtr, tablePtr->flashTime);
2582 
2583     /* now set the timer if it's not already going and invalidate the area */
2584     if (tablePtr->flashTimer == NULL) {
2585 	tablePtr->flashTimer = Tcl_CreateTimerHandler(250, TableFlashEvent,
2586 		(ClientData) tablePtr);
2587     }
2588 }
2589 
2590 /*
2591  *----------------------------------------------------------------------
2592  *
2593  * TableSetActiveIndex --
2594  *	Sets the "active" index of the associated array to the current
2595  *	value of the active buffer.
2596  *
2597  * Results:
2598  *	None.
2599  *
2600  * Side effects:
2601  *	Traces on the array can cause side effects.
2602  *
2603  *----------------------------------------------------------------------
2604  */
2605 void
TableSetActiveIndex(register Table * tablePtr)2606 TableSetActiveIndex(register Table *tablePtr)
2607 {
2608     if (tablePtr->arrayVar) {
2609 	tablePtr->flags |= SET_ACTIVE;
2610 	Tcl_SetVar2(tablePtr->interp, tablePtr->arrayVar, "active",
2611 		tablePtr->activeBuf, TCL_GLOBAL_ONLY);
2612 	tablePtr->flags &= ~SET_ACTIVE;
2613     }
2614 }
2615 
2616 /*
2617  *----------------------------------------------------------------------
2618  *
2619  * TableGetActiveBuf --
2620  *	Get the current selection into the buffer and mark it as unedited.
2621  *	Set the position to the end of the string.
2622  *
2623  * Results:
2624  *	None.
2625  *
2626  * Side effects:
2627  *	tablePtr->activeBuf will change.
2628  *
2629  *----------------------------------------------------------------------
2630  */
2631 void
TableGetActiveBuf(register Table * tablePtr)2632 TableGetActiveBuf(register Table *tablePtr)
2633 {
2634     char *data = "";
2635 
2636     if (tablePtr->flags & HAS_ACTIVE) {
2637 	data = TableGetCellValue(tablePtr,
2638 		tablePtr->activeRow+tablePtr->rowOffset,
2639 		tablePtr->activeCol+tablePtr->colOffset);
2640     }
2641 
2642     if (STREQ(tablePtr->activeBuf, data)) {
2643 	/* this forced SetActiveIndex is necessary if we change array vars and
2644 	 * they happen to have these cells equal, we won't properly set the
2645 	 * active index for the new array var unless we do this here */
2646 	TableSetActiveIndex(tablePtr);
2647 	return;
2648     }
2649     /* is the buffer long enough */
2650     tablePtr->activeBuf = (char *)ckrealloc(tablePtr->activeBuf,
2651 	    strlen(data)+1);
2652     strcpy(tablePtr->activeBuf, data);
2653     TableGetIcursor(tablePtr, "end", (int *)0);
2654     tablePtr->flags &= ~TEXT_CHANGED;
2655     TableSetActiveIndex(tablePtr);
2656 }
2657 
2658 /*
2659  *----------------------------------------------------------------------
2660  *
2661  * TableVarProc --
2662  *	This is the trace procedure associated with the Tcl array.  No
2663  *	validation will occur here because this only triggers when the
2664  *	array value is directly set, and we can't maintain the old value.
2665  *
2666  * Results:
2667  *	Invalidates changed cell.
2668  *
2669  * Side effects:
2670  *	Creates/Updates entry in the cache if we are caching.
2671  *
2672  *----------------------------------------------------------------------
2673  */
2674 static char *
TableVarProc(clientData,interp,name,index,flags)2675 TableVarProc(clientData, interp, name, index, flags)
2676      ClientData clientData;	/* Information about table. */
2677      Tcl_Interp *interp;		/* Interpreter containing variable. */
2678      Var  name;			/* Not used. */
2679      char *index;		/* Not used. */
2680      int flags;			/* Information about what happened. */
2681 {
2682     Table *tablePtr = (Table *) clientData;
2683     int row, col, update = 1;
2684 
2685     /* This is redundant, as the name should always == arrayVar */
2686     name = tablePtr->arrayVar;
2687 
2688     /* is this the whole var being destroyed or just one cell being deleted */
2689     if ((flags & TCL_TRACE_UNSETS) && index == NULL) {
2690 	/* if this isn't the interpreter being destroyed reinstate the trace */
2691 	if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) {
2692 	    Tcl_SetVar2(interp, name, TEST_KEY, "", TCL_GLOBAL_ONLY);
2693 	    /* Perltk not supported */
2694 	    /* Tcl_UnsetVar2(interp, LangString(Tcl_GetVar(interp, name, TCL_GLOBAL_ONLY)), TEST_KEY, TCL_GLOBAL_ONLY); */
2695 	    Tcl_ResetResult(interp);
2696 
2697 	    /* set a trace on the variable */
2698 	    Tcl_TraceVar(interp, name,
2699 		    TCL_TRACE_WRITES | TCL_TRACE_UNSETS | TCL_GLOBAL_ONLY,
2700 		    (Tcl_VarTraceProc *)TableVarProc, (ClientData) tablePtr);
2701 
2702 	    /* only do the following if arrayVar is our data source */
2703 	    if (tablePtr->dataSource & DATA_ARRAY) {
2704 		/* clear the selection buffer */
2705 		TableGetActiveBuf(tablePtr);
2706 		/* flush any cache */
2707 		Table_ClearHashTable(tablePtr->cache);
2708 		Tcl_InitHashTable(tablePtr->cache, TCL_STRING_KEYS);
2709 		/* and invalidate the table */
2710 		TableInvalidateAll(tablePtr, 0);
2711 	    }
2712 	}
2713 	return (char *)NULL;
2714     }
2715     /* only continue if arrayVar is our data source */
2716     if (!(tablePtr->dataSource & DATA_ARRAY)) {
2717 	return (char *)NULL;
2718     }
2719     /* get the cell address and invalidate that region only.
2720      * Make sure that it is a valid cell address. */
2721     if (STREQ("active", index)) {
2722 	if (tablePtr->flags & SET_ACTIVE) {
2723 	    /* If we are already setting the active cell, the update
2724 	     * will occur in other code */
2725 	    update = 0;
2726 	} else {
2727 	    /* modified TableGetActiveBuf */
2728 	    CONST char *data = "";
2729 
2730 	    row = tablePtr->activeRow;
2731 	    col = tablePtr->activeCol;
2732 	    if (tablePtr->flags & HAS_ACTIVE)
2733 		data = LangString(Tcl_GetVar2(interp, name, index, TCL_GLOBAL_ONLY));
2734 	    if (!data) data = "";
2735 
2736 	    if (STREQ(tablePtr->activeBuf, data)) {
2737 		return (char *)NULL;
2738 	    }
2739 	    tablePtr->activeBuf = (char *)ckrealloc(tablePtr->activeBuf,
2740 		    strlen(data)+1);
2741 	    strcpy(tablePtr->activeBuf, data);
2742 	    /* set cursor to the last char */
2743 	    TableGetIcursor(tablePtr, "end", (int *)0);
2744 	    tablePtr->flags |= TEXT_CHANGED;
2745 	}
2746     } else if (TableParseArrayIndex(&row, &col, index) == 2) {
2747 	char buf[INDEX_BUFSIZE];
2748 
2749 	/* Make sure it won't trigger on array(2,3extrastuff) */
2750 	TableMakeArrayIndex(row, col, buf);
2751 	if (strcmp(buf, index)) {
2752 	    return (char *)NULL;
2753 	}
2754 	if (tablePtr->caching) {
2755 	    Tcl_HashEntry *entryPtr;
2756 	    int new;
2757 	    char *val, *data;
2758 
2759 	    entryPtr = Tcl_CreateHashEntry(tablePtr->cache, buf, &new);
2760 	    if (!new) {
2761 		data = (char *) Tcl_GetHashValue(entryPtr);
2762 		if (data) { ckfree(data); }
2763 	    }
2764 	    data = LangString(Tcl_GetVar2(interp, name, index, TCL_GLOBAL_ONLY));
2765 	    if (!data) data = "";
2766 	    val = (char *)ckalloc(strlen(data)+1);
2767 	    strcpy(val, data);
2768 	    Tcl_SetHashValue(entryPtr, val);
2769 	}
2770 	/* convert index to real coords */
2771 	row -= tablePtr->rowOffset;
2772 	col -= tablePtr->colOffset;
2773 	/* did the active cell just update */
2774 	if (row == tablePtr->activeRow && col == tablePtr->activeCol) {
2775 	    TableGetActiveBuf(tablePtr);
2776 	}
2777 	/* Flash the cell */
2778 	TableAddFlash(tablePtr, row, col);
2779     } else {
2780 	return (char *)NULL;
2781     }
2782 
2783     if (update) {
2784 	TableRefresh(tablePtr, row, col, CELL);
2785     }
2786 
2787     return (char *)NULL;
2788 }
2789 
2790 /*
2791  *----------------------------------------------------------------------
2792  *
2793  * TableGeometryRequest --
2794  *	This procedure is invoked to request a new geometry from Tk.
2795  *
2796  * Results:
2797  *	None.
2798  *
2799  * Side effects:
2800  *	Geometry information is updated and a new requested size is
2801  *	registered for the widget.  Internal border info is also set.
2802  *
2803  *----------------------------------------------------------------------
2804  */
2805 void
TableGeometryRequest(tablePtr)2806 TableGeometryRequest(tablePtr)
2807      register Table *tablePtr;
2808 {
2809     int x, y;
2810 
2811     /* Do the geometry request
2812      * If -width #cols was not specified or it is greater than the real
2813      * number of cols, use maxWidth as a lower bound, with the other lower
2814      * bound being the upper bound of the window's user-set width and the
2815      * value of -maxwidth set by the programmer
2816      * Vice versa for rows/height
2817      */
2818     x = MIN((tablePtr->maxReqCols==0 || tablePtr->maxReqCols > tablePtr->cols)?
2819 	    tablePtr->maxWidth : tablePtr->colStarts[tablePtr->maxReqCols],
2820 	    tablePtr->maxReqWidth) + 2*tablePtr->highlightWidth;
2821     y = MIN((tablePtr->maxReqRows==0 || tablePtr->maxReqRows > tablePtr->rows)?
2822 	    tablePtr->maxHeight : tablePtr->rowStarts[tablePtr->maxReqRows],
2823 	    tablePtr->maxReqHeight) + 2*tablePtr->highlightWidth;
2824     Tk_GeometryRequest(tablePtr->tkwin, x, y);
2825 }
2826 
2827 /*
2828  *----------------------------------------------------------------------
2829  *
2830  * TableAdjustActive --
2831  *	This procedure is called by AdjustParams and CMD_ACTIVATE to
2832  *	move the active cell.
2833  *
2834  * Results:
2835  *	Old and new active cell indices will be invalidated.
2836  *
2837  * Side effects:
2838  *	If the old active cell index was edited, it will be saved.
2839  *	The active buffer will be updated.
2840  *
2841  *----------------------------------------------------------------------
2842  */
2843 void
TableAdjustActive(tablePtr)2844 TableAdjustActive(tablePtr)
2845      register Table *tablePtr;		/* Widget record for table */
2846 {
2847     if (tablePtr->flags & HAS_ACTIVE) {
2848 	/*
2849 	 * Make sure the active cell has a reasonable real index
2850 	 */
2851 	CONSTRAIN(tablePtr->activeRow, 0, tablePtr->rows-1);
2852 	CONSTRAIN(tablePtr->activeCol, 0, tablePtr->cols-1);
2853     }
2854 
2855     /*
2856      * Check the new value of active cell against the original,
2857      * Only invalidate if it changed.
2858      */
2859     if (tablePtr->oldActRow == tablePtr->activeRow &&
2860 	    tablePtr->oldActCol == tablePtr->activeCol) {
2861 	return;
2862     }
2863 
2864     if (tablePtr->oldActRow >= 0 && tablePtr->oldActCol >= 0) {
2865 	/*
2866 	 * Set the value of the old active cell to the active buffer
2867 	 * SetCellValue will check if the value actually changed
2868 	 */
2869 	if (tablePtr->flags & TEXT_CHANGED) {
2870 	    /* WARNING an outside trace will be triggered here and if it
2871 	     * calls something that causes TableAdjustParams to be called
2872 	     * again, we are in data consistency trouble */
2873 	    /* HACK - turn TEXT_CHANGED off now to possibly avoid the
2874 	     * above data inconsistency problem.  */
2875 	    tablePtr->flags &= ~TEXT_CHANGED;
2876 	    TableSetCellValue(tablePtr,
2877 		    tablePtr->oldActRow + tablePtr->rowOffset,
2878 		    tablePtr->oldActCol + tablePtr->colOffset,
2879 		    tablePtr->activeBuf);
2880 	}
2881 	/*
2882 	 * Invalidate the old active cell
2883 	 */
2884 	TableRefresh(tablePtr, tablePtr->oldActRow, tablePtr->oldActCol, CELL);
2885     }
2886 
2887     /*
2888      * Store the new active cell value into the active buffer
2889      */
2890     TableGetActiveBuf(tablePtr);
2891 
2892     /*
2893      * Invalidate the new active cell
2894      */
2895     TableRefresh(tablePtr, tablePtr->activeRow, tablePtr->activeCol, CELL);
2896 
2897     /*
2898      * Cache the old active row/col for the next time this is called
2899      */
2900     tablePtr->oldActRow = tablePtr->activeRow;
2901     tablePtr->oldActCol = tablePtr->activeCol;
2902 }
2903 
2904 /*
2905  *----------------------------------------------------------------------
2906  *
2907  * TableAdjustParams --
2908  *	Calculate the row and column starts.  Adjusts the topleft corner
2909  *	variable to keep it within the screen range, out of the titles
2910  *	and keep the screen full make sure the selected cell is in the
2911  *	visible area checks to see if the top left cell has changed at
2912  *	all and invalidates the table if it has.
2913  *
2914  * Results:
2915  *	None.
2916  *
2917  * Side Effects:
2918  *	Number of rows can change if -rowstretchmode == fill.
2919  *	topRow && leftCol can change to fit display.
2920  *	activeRow/Col can change to ensure it is a valid cell.
2921  *
2922  *----------------------------------------------------------------------
2923  */
2924 void
TableAdjustParams(register Table * tablePtr)2925 TableAdjustParams(register Table *tablePtr)
2926 {
2927     int topRow, leftCol, row, col, total, i, value, x, y, width, height,
2928 	w, h, hl, px, py, recalc, bd[4],
2929 	diff, unpreset, lastUnpreset, pad, lastPad, numPixels,
2930 	defColWidth, defRowHeight;
2931     Tcl_HashEntry *entryPtr;
2932 
2933     /*
2934      * Cache some values for many upcoming calculations
2935      */
2936     hl = tablePtr->highlightWidth;
2937     w  = Tk_Width(tablePtr->tkwin) - (2 * hl);
2938     h  = Tk_Height(tablePtr->tkwin) - (2 * hl);
2939     TableGetTagBorders(&(tablePtr->defaultTag),
2940 	    &bd[0], &bd[1], &bd[2], &bd[3]);
2941     px = bd[0] + bd[1] + (2 * tablePtr->padX);
2942     py = bd[2] + bd[3] + (2 * tablePtr->padY);
2943 
2944     /*
2945      * Account for whether default dimensions are in chars (>0) or
2946      * pixels (<=0).  Border and Pad space is added in here for convenience.
2947      *
2948      * When a value in pixels is specified, we take that exact amount,
2949      * not adding in padding.
2950      */
2951     if (tablePtr->defColWidth > 0) {
2952 	defColWidth = tablePtr->charWidth * tablePtr->defColWidth + px;
2953     } else {
2954 	defColWidth = -(tablePtr->defColWidth);
2955     }
2956     if (tablePtr->defRowHeight > 0) {
2957 	defRowHeight = tablePtr->charHeight * tablePtr->defRowHeight + py;
2958     } else {
2959 	defRowHeight = -(tablePtr->defRowHeight);
2960     }
2961 
2962     /*
2963      * Set up the arrays to hold the col pixels and starts.
2964      * ckrealloc was fixed in 8.2.1 to handle NULLs, so we can't rely on it.
2965      */
2966     if (tablePtr->colPixels) ckfree((char *) tablePtr->colPixels);
2967     tablePtr->colPixels = (int *) ckalloc(tablePtr->cols * sizeof(int));
2968     if (tablePtr->colStarts) ckfree((char *) tablePtr->colStarts);
2969     tablePtr->colStarts = (int *) ckalloc((tablePtr->cols+1) * sizeof(int));
2970 
2971     /*
2972      * Get all the preset columns and set their widths
2973      */
2974     lastUnpreset = 0;
2975     numPixels = 0;
2976     unpreset = 0;
2977     for (i = 0; i < tablePtr->cols; i++) {
2978 	entryPtr = Tcl_FindHashEntry(tablePtr->colWidths, (char *) i);
2979 	if (entryPtr == NULL) {
2980 	    tablePtr->colPixels[i] = -1;
2981 	    unpreset++;
2982 	    lastUnpreset = i;
2983 	} else {
2984 	    value = (int) Tcl_GetHashValue(entryPtr);
2985 	    if (value > 0) {
2986 		tablePtr->colPixels[i] = value * tablePtr->charWidth + px;
2987 	    } else {
2988 		/*
2989 		 * When a value in pixels is specified, we take that exact
2990 		 * amount, not adding in pad or border values.
2991 		 */
2992 		tablePtr->colPixels[i] = -value;
2993 	    }
2994 	    numPixels += tablePtr->colPixels[i];
2995 	}
2996     }
2997 
2998     /*
2999      * Work out how much to pad each col depending on the mode.
3000      */
3001     diff  = w - numPixels - (unpreset * defColWidth);
3002     total = 0;
3003 
3004     /*
3005      * Now do the padding and calculate the column starts.
3006      * Diff lower than 0 means we can't see the entire set of columns,
3007      * thus no special stretching will occur & we optimize the calculation.
3008      */
3009     if (diff <= 0) {
3010 	for (i = 0; i < tablePtr->cols; i++) {
3011 	    if (tablePtr->colPixels[i] == -1) {
3012 		tablePtr->colPixels[i] = defColWidth;
3013 	    }
3014 	    tablePtr->colStarts[i] = total;
3015 	    total += tablePtr->colPixels[i];
3016 	}
3017     } else {
3018 	switch (tablePtr->colStretch) {
3019 	case STRETCH_MODE_NONE:
3020 	    pad		= 0;
3021 	    lastPad	= 0;
3022 	    break;
3023 	case STRETCH_MODE_UNSET:
3024 	    if (unpreset == 0) {
3025 		pad	= 0;
3026 		lastPad	= 0;
3027 	    } else {
3028 		pad	= diff / unpreset;
3029 		lastPad	= diff - pad * (unpreset - 1);
3030 	    }
3031 	    break;
3032 	case STRETCH_MODE_LAST:
3033 	    pad		= 0;
3034 	    lastPad	= diff;
3035 	    lastUnpreset = tablePtr->cols - 1;
3036 	    break;
3037 	default:	/* STRETCH_MODE_ALL, but also FILL for cols */
3038 	    pad		= diff / tablePtr->cols;
3039 	    /* force it to be applied to the last column too */
3040 	    lastUnpreset = tablePtr->cols - 1;
3041 	    lastPad	= diff - pad * lastUnpreset;
3042 	}
3043 
3044 	for (i = 0; i < tablePtr->cols; i++) {
3045 	    if (tablePtr->colPixels[i] == -1) {
3046 		tablePtr->colPixels[i] = defColWidth
3047 		    + ((i == lastUnpreset) ? lastPad : pad);
3048 	    } else if (tablePtr->colStretch == STRETCH_MODE_ALL) {
3049 		tablePtr->colPixels[i] += (i == lastUnpreset) ? lastPad : pad;
3050 	    }
3051 	    tablePtr->colStarts[i] = total;
3052 	    total += tablePtr->colPixels[i];
3053 	}
3054     }
3055     tablePtr->colStarts[i] = tablePtr->maxWidth = total;
3056 
3057     /*
3058      * The 'do' loop is only necessary for rows because of FILL mode
3059      */
3060     recalc = 0;
3061     do {
3062 	/* Set up the arrays to hold the row pixels and starts */
3063 	/* FIX - this can be moved outside 'do' if you check >row size */
3064 	if (tablePtr->rowPixels) ckfree((char *) tablePtr->rowPixels);
3065 	tablePtr->rowPixels = (int *) ckalloc(tablePtr->rows * sizeof(int));
3066 
3067 	/* get all the preset rows and set their heights */
3068 	lastUnpreset	= 0;
3069 	numPixels	= 0;
3070 	unpreset	= 0;
3071 	for (i = 0; i < tablePtr->rows; i++) {
3072 	    entryPtr = Tcl_FindHashEntry(tablePtr->rowHeights, (char *) i);
3073 	    if (entryPtr == NULL) {
3074 		tablePtr->rowPixels[i] = -1;
3075 		unpreset++;
3076 		lastUnpreset = i;
3077 	    } else {
3078 		value = (int) Tcl_GetHashValue(entryPtr);
3079 		if (value > 0) {
3080 		    tablePtr->rowPixels[i] = value * tablePtr->charHeight + py;
3081 		} else {
3082 		    /*
3083 		     * When a value in pixels is specified, we take that exact
3084 		     * amount, not adding in pad or border values.
3085 		     */
3086 		    tablePtr->rowPixels[i] = -value;
3087 		}
3088 		numPixels += tablePtr->rowPixels[i];
3089 	    }
3090 	}
3091 
3092 	/* work out how much to pad each row depending on the mode */
3093 	diff = h - numPixels - (unpreset * defRowHeight);
3094 	switch(tablePtr->rowStretch) {
3095 	case STRETCH_MODE_NONE:
3096 	    pad		= 0;
3097 	    lastPad	= 0;
3098 	    break;
3099 	case STRETCH_MODE_UNSET:
3100 	    if (unpreset == 0)  {
3101 		pad	= 0;
3102 		lastPad	= 0;
3103 	    } else {
3104 		pad	= MAX(0,diff) / unpreset;
3105 		lastPad	= MAX(0,diff) - pad * (unpreset - 1);
3106 	    }
3107 	    break;
3108 	case STRETCH_MODE_LAST:
3109 	    pad		= 0;
3110 	    lastPad	= MAX(0,diff);
3111 	    /* force it to be applied to the last column too */
3112 	    lastUnpreset = tablePtr->rows - 1;
3113 	    break;
3114 	case STRETCH_MODE_FILL:
3115 	    pad		= 0;
3116 	    lastPad	= diff;
3117 	    if (diff && !recalc) {
3118 		tablePtr->rows += (diff/defRowHeight);
3119 		if (diff < 0 && tablePtr->rows <= 0) {
3120 		    tablePtr->rows = 1;
3121 		}
3122 		lastUnpreset = tablePtr->rows - 1;
3123 		recalc = 1;
3124 		continue;
3125 	    } else {
3126 		lastUnpreset = tablePtr->rows - 1;
3127 		recalc = 0;
3128 	    }
3129 	    break;
3130 	default:	/* STRETCH_MODE_ALL */
3131 	    pad		= MAX(0,diff) / tablePtr->rows;
3132 	    /* force it to be applied to the last column too */
3133 	    lastUnpreset = tablePtr->rows - 1;
3134 	    lastPad	= MAX(0,diff) - pad * lastUnpreset;
3135 	}
3136     } while (recalc);
3137 
3138     if (tablePtr->rowStarts) ckfree((char *) tablePtr->rowStarts);
3139     tablePtr->rowStarts = (int *) ckalloc((tablePtr->rows+1)*sizeof(int));
3140     /*
3141      * Now do the padding and calculate the row starts
3142      */
3143     total = 0;
3144     for (i = 0; i < tablePtr->rows; i++) {
3145 	if (tablePtr->rowPixels[i] == -1) {
3146 	    tablePtr->rowPixels[i] = defRowHeight
3147 		+ ((i==lastUnpreset)?lastPad:pad);
3148 	} else if (tablePtr->rowStretch == STRETCH_MODE_ALL) {
3149 	    tablePtr->rowPixels[i] += (i==lastUnpreset)?lastPad:pad;
3150 	}
3151 	/* calculate the start of each row */
3152 	tablePtr->rowStarts[i] = total;
3153 	total += tablePtr->rowPixels[i];
3154     }
3155     tablePtr->rowStarts[i] = tablePtr->maxHeight = total;
3156 
3157     /*
3158      * Make sure the top row and col have reasonable real indices
3159      */
3160     CONSTRAIN(tablePtr->topRow, tablePtr->titleRows, tablePtr->rows-1);
3161     CONSTRAIN(tablePtr->leftCol, tablePtr->titleCols, tablePtr->cols-1);
3162 
3163     /*
3164      * If we don't have the info, don't bother to fix up the other parameters
3165      */
3166     if (Tk_WindowId(tablePtr->tkwin) == None) {
3167 	tablePtr->oldTopRow = tablePtr->oldLeftCol = -1;
3168 	return;
3169     }
3170 
3171     topRow  = tablePtr->topRow;
3172     leftCol = tablePtr->leftCol;
3173     w += hl;
3174     h += hl;
3175     /*
3176      * If we use this value of topRow, will we fill the window?
3177      * if not, decrease it until we will, or until it gets to titleRows
3178      * make sure we don't cut off the bottom row
3179      */
3180     for (; topRow > tablePtr->titleRows; topRow--) {
3181 	if ((tablePtr->maxHeight-(tablePtr->rowStarts[topRow-1] -
3182 		tablePtr->rowStarts[tablePtr->titleRows])) > h) {
3183 	    break;
3184 	}
3185     }
3186     /*
3187      * If we use this value of topCol, will we fill the window?
3188      * if not, decrease it until we will, or until it gets to titleCols
3189      * make sure we don't cut off the left column
3190      */
3191     for (; leftCol > tablePtr->titleCols; leftCol--) {
3192 	if ((tablePtr->maxWidth-(tablePtr->colStarts[leftCol-1] -
3193 		tablePtr->colStarts[tablePtr->titleCols])) > w) {
3194 	    break;
3195 	}
3196     }
3197 
3198     tablePtr->topRow  = topRow;
3199     tablePtr->leftCol = leftCol;
3200 
3201     /*
3202      * Now work out where the bottom right is for scrollbar update and to test
3203      * for one last stretch.  Avoid the confusion that spans could cause for
3204      * determining the last cell dimensions.
3205      */
3206     tablePtr->flags |= AVOID_SPANS;
3207     TableGetLastCell(tablePtr, &row, &col);
3208     TableCellVCoords(tablePtr, row, col, &x, &y, &width, &height, 0);
3209     tablePtr->flags &= ~AVOID_SPANS;
3210 
3211     /*
3212      * Do we have scrollbars, if so, calculate and call the TCL functions In
3213      * order to get the scrollbar to be completely full when the whole screen
3214      * is shown and there are titles, we have to arrange for the scrollbar
3215      * range to be 0 -> rows-titleRows etc.  This leads to the position
3216      * setting methods, toprow and leftcol, being relative to the titles, not
3217      * absolute row and column numbers.
3218      */
3219     if (tablePtr->yScrollCmd != NULL || tablePtr->xScrollCmd != NULL) {
3220 	Tcl_Interp *interp = tablePtr->interp;
3221 	char buf[INDEX_BUFSIZE];
3222 	double first, last;
3223 
3224 	/*
3225 	 * We must hold onto the interpreter because the data referred to at
3226 	 * tablePtr might be freed as a result of the call to Tcl_VarEval.
3227 	 */
3228 	Tcl_Preserve((ClientData) interp);
3229 
3230 	/* Do we have a Y-scrollbar and rows to scroll? */
3231 	if (tablePtr->yScrollCmd != NULL) {
3232 	    if (row < tablePtr->titleRows) {
3233 		first = 0;
3234 		last  = 1;
3235 	    } else {
3236 		diff = tablePtr->rowStarts[tablePtr->titleRows];
3237 		last = (double) (tablePtr->rowStarts[tablePtr->rows]-diff);
3238 		if (last <= 0.0) {
3239 		    first = 0;
3240 		    last  = 1;
3241 		} else {
3242 		    first = (tablePtr->rowStarts[topRow]-diff) / last;
3243 		    last  = (height+tablePtr->rowStarts[row]-diff) / last;
3244 		}
3245 	    }
3246 	    if ( LangDoCallback(interp,tablePtr->yScrollCmd, 0,2, " %g %g", first, last)
3247 		 != TCL_OK) {
3248 		Tcl_AddErrorInfo(interp,
3249 			"\n\t(vertical scrolling command executed by table)");
3250 		Tcl_BackgroundError(interp);
3251 	    }
3252 	}
3253 	/* Do we have a X-scrollbar and cols to scroll? */
3254 	if (tablePtr->xScrollCmd != NULL) {
3255 	    if (col < tablePtr->titleCols) {
3256 		first = 0;
3257 		last  = 1;
3258 	    } else {
3259 		diff = tablePtr->colStarts[tablePtr->titleCols];
3260 		last = (double) (tablePtr->colStarts[tablePtr->cols]-diff);
3261 		if (last <= 0.0) {
3262 		    first = 0;
3263 		    last  = 1;
3264 		} else {
3265 		    first = (tablePtr->colStarts[leftCol]-diff) / last;
3266 		    last  = (width+tablePtr->colStarts[col]-diff) / last;
3267 		}
3268 	    }
3269 	    if ( LangDoCallback(interp,tablePtr->xScrollCmd, 0,2, " %g %g", first, last)
3270 		 != TCL_OK) {
3271 		Tcl_AddErrorInfo(interp,
3272 			"\n\t(horizontal scrolling command executed by table)");
3273 		Tcl_BackgroundError(interp);
3274 	    }
3275 	}
3276 
3277 	Tcl_Release((ClientData) interp);
3278     }
3279 
3280     /*
3281      * Adjust the last row/col to fill empty space if it is visible.
3282      * Do this after setting the scrollbars to not upset its calculations.
3283      */
3284     if (row == tablePtr->rows-1 && tablePtr->rowStretch != STRETCH_MODE_NONE) {
3285 	diff = h-(y+height);
3286 	if (diff > 0) {
3287 	    tablePtr->rowPixels[tablePtr->rows-1] += diff;
3288 	    tablePtr->rowStarts[tablePtr->rows] += diff;
3289 	}
3290     }
3291     if (col == tablePtr->cols-1 && tablePtr->colStretch != STRETCH_MODE_NONE) {
3292 	diff = w-(x+width);
3293 	if (diff > 0) {
3294 	    tablePtr->colPixels[tablePtr->cols-1] += diff;
3295 	    tablePtr->colStarts[tablePtr->cols] += diff;
3296 	}
3297     }
3298 
3299     TableAdjustActive(tablePtr);
3300 
3301     /*
3302      * now check the new value of topleft cell against the originals,
3303      * If they changed, invalidate the area, else leave it alone
3304      */
3305     if (tablePtr->topRow != tablePtr->oldTopRow ||
3306 	tablePtr->leftCol != tablePtr->oldLeftCol) {
3307 	/* set the old top row/col for the next time this function is called */
3308 	tablePtr->oldTopRow = tablePtr->topRow;
3309 	tablePtr->oldLeftCol = tablePtr->leftCol;
3310 	/* only the upper corner title cells wouldn't change */
3311 	TableInvalidateAll(tablePtr, 0);
3312     }
3313 }
3314 
3315 /*
3316  *----------------------------------------------------------------------
3317  *
3318  * TableCursorEvent --
3319  *	Toggle the cursor status.  Equivalent to EntryBlinkProc.
3320  *
3321  * Results:
3322  *	None.
3323  *
3324  * Side effects:
3325  *	The cursor will be switched off/on.
3326  *
3327  *----------------------------------------------------------------------
3328  */
3329 static void
TableCursorEvent(ClientData clientData)3330 TableCursorEvent(ClientData clientData)
3331 {
3332     register Table *tablePtr = (Table *) clientData;
3333 
3334     if (!(tablePtr->flags & HAS_FOCUS) || (tablePtr->insertOffTime == 0)
3335 	    || (tablePtr->flags & ACTIVE_DISABLED)
3336 	    || (tablePtr->state != STATE_NORMAL)) {
3337 	return;
3338     }
3339 
3340     if (tablePtr->cursorTimer != NULL) {
3341 	Tcl_DeleteTimerHandler(tablePtr->cursorTimer);
3342     }
3343 
3344     tablePtr->cursorTimer =
3345 	Tcl_CreateTimerHandler((tablePtr->flags & CURSOR_ON) ?
3346 		tablePtr->insertOffTime : tablePtr->insertOnTime,
3347 		TableCursorEvent, (ClientData) tablePtr);
3348 
3349     /* Toggle the cursor */
3350     tablePtr->flags ^= CURSOR_ON;
3351 
3352     /* invalidate the cell */
3353     TableRefresh(tablePtr, tablePtr->activeRow, tablePtr->activeCol, CELL);
3354 }
3355 
3356 /*
3357  *----------------------------------------------------------------------
3358  *
3359  * TableConfigCursor --
3360  *	Configures the timer depending on the state of the table.
3361  *	Equivalent to EntryFocusProc.
3362  *
3363  * Results:
3364  *	None.
3365  *
3366  * Side effects:
3367  *	The cursor will be switched off/on.
3368  *
3369  *----------------------------------------------------------------------
3370  */
3371 void
TableConfigCursor(register Table * tablePtr)3372 TableConfigCursor(register Table *tablePtr)
3373 {
3374     /*
3375      * To have a cursor, we have to have focus and allow edits
3376      */
3377     if ((tablePtr->flags & HAS_FOCUS) && (tablePtr->state == STATE_NORMAL) &&
3378 	!(tablePtr->flags & ACTIVE_DISABLED)) {
3379 	/*
3380 	 * Turn the cursor ON
3381 	 */
3382 	if (!(tablePtr->flags & CURSOR_ON)) {
3383 	    tablePtr->flags |= CURSOR_ON;
3384 	    /*
3385 	     * Only refresh when we toggled cursor
3386 	     */
3387 	    TableRefresh(tablePtr, tablePtr->activeRow, tablePtr->activeCol,
3388 		    CELL);
3389 	}
3390 
3391 	/* set up the first timer */
3392 	if (tablePtr->insertOffTime != 0) {
3393 	    /* make sure nothing existed */
3394 	    Tcl_DeleteTimerHandler(tablePtr->cursorTimer);
3395 	    tablePtr->cursorTimer =
3396 		Tcl_CreateTimerHandler(tablePtr->insertOnTime,
3397 			TableCursorEvent, (ClientData) tablePtr);
3398 	}
3399     } else {
3400 	/*
3401 	 * Turn the cursor OFF
3402 	 */
3403 	if ((tablePtr->flags & CURSOR_ON)) {
3404 	    tablePtr->flags &= ~CURSOR_ON;
3405 	    TableRefresh(tablePtr, tablePtr->activeRow, tablePtr->activeCol,
3406 		    CELL);
3407 	}
3408 
3409 	/* and disable the timer */
3410 	if (tablePtr->cursorTimer != NULL) {
3411 	    Tcl_DeleteTimerHandler(tablePtr->cursorTimer);
3412 	}
3413 	tablePtr->cursorTimer = NULL;
3414     }
3415 
3416 }
3417 
3418 /*
3419  *----------------------------------------------------------------------
3420  *
3421  * TableFetchSelection --
3422  *	This procedure is called back by Tk when the selection is
3423  *	requested by someone.  It returns part or all of the selection
3424  *	in a buffer provided by the caller.
3425  *
3426  * Results:
3427  *	The return value is the number of non-NULL bytes stored
3428  *	at buffer.  Buffer is filled (or partially filled) with a
3429  *	NULL-terminated string containing part or all of the selection,
3430  *	as given by offset and maxBytes.
3431  *
3432  * Side effects:
3433  *	None.
3434  *
3435  *----------------------------------------------------------------------
3436  */
3437 static int SelectionFetched = 0;  /* Flag = 1 if a selection has been fetched before */
3438 
3439 static int
TableFetchSelection(clientData,offset,buffer,maxBytes)3440 TableFetchSelection(clientData, offset, buffer, maxBytes)
3441      ClientData clientData;	/* Information about table widget. */
3442      int offset;		/* Offset within selection of first
3443 				 * character to be returned. */
3444      char *buffer;		/* Location in which to place selection. */
3445      int maxBytes;		/* Maximum number of bytes to place at buffer,
3446 				 * not including terminating NULL. */
3447 {
3448     register Table *tablePtr = (Table *) clientData;
3449     Tcl_Interp *interp = tablePtr->interp;
3450     char *data, *rowsep = tablePtr->rowSep, *colsep = tablePtr->colSep;
3451 
3452     /* We keep a static selection around so we don't have to remake the
3453        selection if we are getting the selection in chunks (i.e. offset != 0)
3454      */
3455     static Tcl_DString selection;
3456 
3457     Tcl_HashEntry *entryPtr;
3458     Tcl_HashSearch search;
3459     int length, count, lastrow=0, needcs=0, r, c, listArgc, rslen=0, cslen=0;
3460     int numcols, numrows;
3461     Arg *listArgv;
3462     Arg value;
3463 
3464 
3465     /* if we are not exporting the selection ||
3466      * we have no data source, return */
3467     if (!tablePtr->exportSelection ||
3468 	(tablePtr->dataSource == DATA_NONE)) {
3469 	return -1;
3470     }
3471 
3472 
3473     if( offset == 0){  /* First Time thru, get the selection, otherwise, just use
3474     			  the selection obtained before */
3475             Tk_Cursor  existingCursor;
3476 
3477             existingCursor = tablePtr->cursor;
3478 	   /* Set Cursor to wait, becuase this can take some time for large selections */
3479 	    /* tablePtr->cursor = Tk_GetCursor(interp, tablePtr->tkwin, LangStringArg("watch")); */
3480             Tk_DefineCursor(tablePtr->tkwin, Tk_GetCursor(interp, tablePtr->tkwin, LangStringArg("watch")));
3481 
3482 	    Tcl_DoOneEvent(TCL_DONT_WAIT);
3483 
3484             if( SelectionFetched){ /* If we have fetched a selection before, free it */
3485 	    	    Tcl_DStringFree(&selection);
3486 	    }
3487 
3488     	    SelectionFetched = 1;
3489 
3490 	    /* First get a sorted list of the selected elements */
3491 	    Tcl_DStringInit(&selection);
3492 	    for (entryPtr = Tcl_FirstHashEntry(tablePtr->selCells, &search);
3493 		 entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&search)) {
3494 		Tcl_DStringAppendElement(&selection,
3495 					 Tcl_GetHashKey(tablePtr->selCells, entryPtr));
3496 	    }
3497 	    value = TableCellSort(tablePtr, Tcl_DStringValue(&selection));
3498 	    Tcl_DStringFree(&selection);
3499 	    if (value == NULL ||
3500 		Tcl_ListObjGetElements(interp, value, &listArgc, &listArgv) != TCL_OK) {
3501     	        Tk_DefineCursor(tablePtr->tkwin, existingCursor); /* Set Cursor Back */
3502 		return -1;
3503 	    }
3504 
3505 	    Tcl_DStringInit(&selection);
3506 	    rslen = (rowsep?(strlen(rowsep)):0);
3507 	    cslen = (colsep?(strlen(colsep)):0);
3508 	    numrows = numcols = 0;
3509 	    for (count = 0; count < listArgc; count++) {
3510 		TableParseArrayIndex(&r, &c, LangString(listArgv[count]));
3511 		if (count) {
3512 		    if (lastrow != r) {
3513 			lastrow = r;
3514 			needcs = 0;
3515 			if (rslen) {
3516 			    Tcl_DStringAppend(&selection, rowsep, rslen);
3517 	        	/* perltk: Temporarily?? commented out, don't have a Tcl_DtringStartSublist
3518 			} else {
3519 			    Tcl_DStringEndSublist(&selection);
3520 			    Tcl_DStringStartSublist(&selection);
3521 			*/
3522 			}
3523 			++numrows;
3524 		    } else {
3525 			if (++needcs > numcols)
3526 			    numcols = needcs;
3527 		    }
3528 		} else {
3529 		    lastrow = r;
3530 		    needcs = 0;
3531 		    /* perltk: Temporarily?? commented out, don't have a Tcl_DtringStartSublist
3532 		    if (!rslen)
3533 			Tcl_DStringStartSublist(&selection);
3534 		    */
3535 		}
3536 		data = TableGetCellValue(tablePtr, r, c);
3537 		if (cslen) {
3538 		    if (needcs) {
3539 			Tcl_DStringAppend(&selection, colsep, cslen);
3540 		    }
3541 		    Tcl_DStringAppend(&selection, data, -1);
3542 		} else {
3543 		    Tcl_DStringAppendElement(&selection, data);
3544 		}
3545 	    }
3546 	    /* perltk: Temporarily?? commented out, don't have a Tcl_DtringStartSublist
3547 	    if (!rslen && count) {
3548 		Tcl_DStringEndSublist(&selection);
3549 	    }
3550 	    */
3551 
3552 	    if (tablePtr->selCmd != NULL) {
3553         	if ( LangDoCallback(interp, tablePtr->selCmd, 1, 4, "%d %d %s %d",
3554     	        	 numrows+1, numcols+1,
3555 			 Tcl_DStringValue(&selection),
3556 			 listArgc) == TCL_ERROR) {
3557 		    Tcl_AddErrorInfo(interp,
3558 				     "\n    (error in table selection command)");
3559 		    Tcl_BackgroundError(interp);
3560     	            Tk_DefineCursor(tablePtr->tkwin, existingCursor); /* Set Cursor Back */
3561 		    Tcl_DStringFree(&selection);
3562 		    return -1;
3563 		} else {
3564 		    Tcl_DStringFree(&selection);
3565 		    Tcl_DStringInit(&selection);
3566 		    Tcl_DStringAppendElement(&selection, Tcl_GetResult(interp));
3567 		}
3568 	    }
3569 
3570     	    Tk_DefineCursor(tablePtr->tkwin, existingCursor); /* Set Cursor Back */
3571 
3572 
3573     }
3574 
3575     length = Tcl_DStringLength(&selection);
3576 
3577     if (length == 0){
3578 	return -1;
3579     }
3580 
3581     /* Copy the requested portion of the selection to the buffer. */
3582     count = length - offset;
3583     if (count <= 0) {
3584 	count = 0;
3585     } else {
3586 	if (count > maxBytes) {
3587 	    count = maxBytes;
3588 	}
3589 	memcpy((VOID *) buffer,
3590 	       (VOID *) (Tcl_DStringValue(&selection) + offset),
3591 	       (size_t) count);
3592     }
3593     buffer[count] = '\0';
3594 
3595     return count;
3596 }
3597 
3598 /*
3599  *----------------------------------------------------------------------
3600  *
3601  * TableLostSelection --
3602  *	This procedure is called back by Tk when the selection is
3603  *	grabbed away from a table widget.
3604  *
3605  * Results:
3606  *	None.
3607  *
3608  * Side effects:
3609  *	The existing selection is unhighlighted, and the window is
3610  *	marked as not containing a selection.
3611  *
3612  *----------------------------------------------------------------------
3613  */
3614 void
TableLostSelection(clientData)3615 TableLostSelection(clientData)
3616      ClientData clientData;	/* Information about table widget. */
3617 {
3618     register Table *tablePtr = (Table *) clientData;
3619 
3620     if (tablePtr->exportSelection) {
3621 	Tcl_HashEntry *entryPtr;
3622 	Tcl_HashSearch search;
3623 	int row, col;
3624 
3625 	/* Same as SEL CLEAR ALL */
3626 	for (entryPtr = Tcl_FirstHashEntry(tablePtr->selCells, &search);
3627 	     entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&search)) {
3628 	    TableParseArrayIndex(&row, &col,
3629 				 Tcl_GetHashKey(tablePtr->selCells,entryPtr));
3630 	    Tcl_DeleteHashEntry(entryPtr);
3631 	    TableRefresh(tablePtr, row-tablePtr->rowOffset,
3632 			 col-tablePtr->colOffset, CELL);
3633 	}
3634     }
3635 }
3636 
3637 /*
3638  *----------------------------------------------------------------------
3639  *
3640  * TableRestrictProc --
3641  *	A Tk_RestrictProc used by TableValidateChange to eliminate any
3642  *	extra key input events in the event queue that
3643  *	have a serial number no less than a given value.
3644  *
3645  * Results:
3646  *	Returns either TK_DISCARD_EVENT or TK_DEFER_EVENT.
3647  *
3648  * Side effects:
3649  *	None.
3650  *
3651  *----------------------------------------------------------------------
3652  */
3653 static Tk_RestrictAction
TableRestrictProc(serial,eventPtr)3654 TableRestrictProc(serial, eventPtr)
3655      ClientData serial;
3656      XEvent *eventPtr;
3657 {
3658     if ((eventPtr->type == KeyRelease || eventPtr->type == KeyPress) &&
3659 	((eventPtr->xany.serial-(unsigned int)serial) > 0)) {
3660 	return TK_DEFER_EVENT;
3661     } else {
3662 	return TK_PROCESS_EVENT;
3663     }
3664 }
3665 
3666 /*
3667  *--------------------------------------------------------------
3668  *
3669  * TableValidateChange --
3670  *	This procedure is invoked when any character is added or
3671  *	removed from the table widget, or a set has triggered validation.
3672  *
3673  * Results:
3674  *	TCL_OK    if the validatecommand accepts the new string,
3675  *	TCL_BREAK if the validatecommand rejects the new string,
3676  *      TCL_ERROR if any problems occured with validatecommand.
3677  *
3678  * Side effects:
3679  *      The insertion/deletion may be aborted, and the
3680  *      validatecommand might turn itself off (if an error
3681  *      or loop condition arises).
3682  *
3683  *--------------------------------------------------------------
3684  */
3685 int
TableValidateChange(tablePtr,r,c,old,new,index)3686 TableValidateChange(tablePtr, r, c, old, new, index)
3687      register Table *tablePtr;	/* Table that needs validation. */
3688      int r, c;			/* row,col index of cell in user coords */
3689      char *old;			/* current value of cell */
3690      char *new;			/* potential new value of cell */
3691      int index;			/* index of insert/delete, -1 otherwise */
3692 {
3693     register Tcl_Interp *interp = tablePtr->interp;
3694     int code, booln; /* perltk: Bool to booln to avoid problems with DEFINES*/
3695     Tk_RestrictProc *rstrct;
3696     ClientData cdata;
3697 
3698     if (tablePtr->valCmd == NULL || tablePtr->validate == 0) {
3699 	return TCL_OK;
3700     }
3701 
3702     /* Magic code to make this bit of code UI synchronous in the face of
3703      * possible new key events */
3704     XSync(tablePtr->display, False);
3705     rstrct = Tk_RestrictEvents(TableRestrictProc, (ClientData)
3706 				 NextRequest(tablePtr->display), &cdata);
3707 
3708     /*
3709      * If we're already validating, then we're hitting a loop condition
3710      * Return and set validate to 0 to disallow further validations
3711      * and prevent current validation from finishing
3712      */
3713     if (tablePtr->flags & VALIDATING) {
3714 	tablePtr->validate = 0;
3715 	return TCL_OK;
3716     }
3717     tablePtr->flags |= VALIDATING;
3718 
3719     code = LangDoCallback(tablePtr->interp, tablePtr->valCmd, 1, 5, "%d %d %s %s %d",
3720     	r, c, old, new, index);
3721 
3722 
3723     if (code != TCL_OK && code != TCL_RETURN) {
3724 	Tcl_AddErrorInfo(interp,
3725 			 "\n\t(in validation command executed by table)");
3726 	Tcl_BackgroundError(interp);
3727 	code = TCL_ERROR;
3728     } else if (Tcl_GetBooleanFromObj(interp, Tcl_GetObjResult(interp),
3729 				     &booln) != TCL_OK) {
3730 	Tcl_AddErrorInfo(interp,
3731 			 "\n\tboolean not returned by validation command");
3732 	Tcl_BackgroundError(interp);
3733 	code = TCL_ERROR;
3734     } else {
3735 	code = (booln) ? TCL_OK : TCL_BREAK;
3736     }
3737     Tcl_SetStringObj(Tcl_GetObjResult(interp), (char *) NULL, 0);
3738 
3739     /*
3740      * If ->validate has become VALIDATE_NONE during the validation,
3741      * it means that a loop condition almost occured.  Do not allow
3742      * this validation result to finish.
3743      */
3744     if (tablePtr->validate == 0) {
3745 	code = TCL_ERROR;
3746     }
3747 
3748     /* If validate will return ERROR, then disallow further validations */
3749     if (code == TCL_ERROR) {
3750 	tablePtr->validate = 0;
3751     }
3752 
3753     Tk_RestrictEvents(rstrct, cdata, &cdata);
3754     tablePtr->flags &= ~VALIDATING;
3755 
3756     return code;
3757 }
3758 
3759 /*
3760  *--------------------------------------------------------------
3761  *
3762  * ExpandPercents --
3763  *	Given a command and an event, produce a new command
3764  *	by replacing % constructs in the original command
3765  *	with information from the X event.
3766  *
3767  * Results:
3768  *	The new expanded command is appended to the dynamic string
3769  *	given by dsPtr.
3770  *
3771  * Side effects:
3772  *	None.
3773  *
3774  *--------------------------------------------------------------
3775  */
3776 void
ExpandPercents(tablePtr,before,r,c,old,new,index,dsPtr,cmdType)3777 ExpandPercents(tablePtr, before, r, c, old, new, index, dsPtr, cmdType)
3778      Table *tablePtr;		/* Table that needs validation. */
3779      char *before;		/* Command containing percent
3780 				 * expressions to be replaced. */
3781      int r, c;			/* row,col index of cell */
3782      char *old;                 /* current value of cell */
3783      char *new;                 /* potential new value of cell */
3784      int index;                 /* index of insert/delete */
3785      Tcl_DString *dsPtr;        /* Dynamic string in which to append
3786 				 * new command. */
3787      int cmdType;		/* type of command to make %-subs for */
3788 {
3789     int length, spaceNeeded, cvtFlags;
3790 #ifdef TCL_UTF_MAX
3791     Tcl_UniChar ch;
3792 #else
3793     char ch;
3794 #endif
3795     char *string, buf[INDEX_BUFSIZE];
3796 
3797     /* This returns the static value of the string as set in the array */
3798     if (old == NULL && cmdType == CMD_VALIDATE) {
3799 	old = TableGetCellValue(tablePtr, r, c);
3800     }
3801 
3802     while (1) {
3803 	if (*before == '\0') {
3804 	    break;
3805 	}
3806 	/*
3807 	 * Find everything up to the next % character and append it
3808 	 * to the result string.
3809 	 */
3810 
3811 	string = before;
3812 #ifdef TCL_UTF_MAX
3813 	/* No need to convert '%', as it is in ascii range */
3814 	string = (char *) Tcl_UtfFindFirst(before, '%');
3815 #else
3816 	string = strchr(before, '%');
3817 #endif
3818 	if (string == (char *) NULL) {
3819 	    Tcl_DStringAppend(dsPtr, before, -1);
3820 	    break;
3821 	} else if (string != before) {
3822 	    Tcl_DStringAppend(dsPtr, before, string-before);
3823 	    before = string;
3824 	}
3825 
3826 	/*
3827 	 * There's a percent sequence here.  Process it.
3828 	 */
3829 
3830 	before++; /* skip over % */
3831 	if (*before != '\0') {
3832 #ifdef TCL_UTF_MAX
3833 	    before += Tcl_UtfToUniChar(before, &ch);
3834 #else
3835 	    ch = before[0];
3836 	    before++;
3837 #endif
3838 	} else {
3839 	    ch = '%';
3840 	}
3841 	switch (ch) {
3842 	case 'c':
3843 	    sprintf(buf, "%d", c);
3844 	    string = buf;
3845 	    break;
3846 	case 'C': /* index of cell */
3847 	    TableMakeArrayIndex(r, c, buf);
3848 	    string = buf;
3849 	    break;
3850 	case 'r':
3851 	    sprintf(buf, "%d", r);
3852 	    string = buf;
3853 	    break;
3854 	case 'i': /* index of cursor OR |number| of cells selected */
3855 	    sprintf(buf, "%d", index);
3856 	    string = buf;
3857 	    break;
3858 	case 's': /* Current cell value */
3859 	    string = old;
3860 	    break;
3861 	case 'S': /* Potential new value of cell */
3862 	    string = (new?new:old);
3863 	    break;
3864 	case 'W': /* widget name */
3865 	    string = Tk_PathName(tablePtr->tkwin);
3866 	    break;
3867 	default:
3868 #ifdef TCL_UTF_MAX
3869 	    length = Tcl_UniCharToUtf(ch, buf);
3870 #else
3871 	    buf[0] = ch;
3872 	    length = 1;
3873 #endif
3874 	    buf[length] = '\0';
3875 	    string = buf;
3876 	    break;
3877 	}
3878 
3879 	/* perltk not supported */
3880 	/* spaceNeeded = Tcl_ScanElement(string, &cvtFlags); */
3881 	spaceNeeded = 0;
3882 	length = Tcl_DStringLength(dsPtr);
3883 	Tcl_DStringSetLength(dsPtr, length + spaceNeeded);
3884 	/* perltk not supported */
3885 	/* spaceNeeded = Tcl_ConvertElement(string,
3886 					 Tcl_DStringValue(dsPtr) + length,
3887 					 cvtFlags | TCL_DONT_USE_BRACES); */
3888 	Tcl_DStringSetLength(dsPtr, length + spaceNeeded);
3889     }
3890     Tcl_DStringAppend(dsPtr, "", 1);
3891 }
3892 
3893 /* Function to call on loading the Table module */
3894 
3895 #ifdef BUILD_Tktable
3896 #   undef TCL_STORAGE_CLASS
3897 #   define TCL_STORAGE_CLASS DLLEXPORT
3898 #endif
3899 #ifdef MAC_TCL
3900 #pragma export on
3901 #endif
3902 #if 0 /* perltk This not needed by perlTk */
3903 EXTERN int
3904 Tktable_Init(interp)
3905      Tcl_Interp *interp;
3906 {
3907     /* This defines the static char initScript */
3908 
3909     if (
3910 #ifdef USE_TCL_STUBS
3911 	Tcl_InitStubs(interp, "8.0", 0)
3912 #else
3913 	Tcl_PkgRequire(interp, "Tcl", "8.0", 0)
3914 #endif
3915 	== NULL) {
3916 	return TCL_ERROR;
3917     }
3918     if (
3919 #ifdef USE_TK_STUBS
3920 	Tk_InitStubs(interp, "8.0", 0)
3921 #else
3922 #    if (TK_MAJOR_VERSION == 8) && (TK_MINOR_VERSION == 0)
3923 	/* We require 8.0 exact because of the Unicode in 8.1+ */
3924 	Tcl_PkgRequire(interp, "Tk", "8.0", 1)
3925 #    else
3926 	Tcl_PkgRequire(interp, "Tk", "8.0", 0)
3927 #    endif
3928 #endif
3929 	== NULL) {
3930 	return TCL_ERROR;
3931     }
3932     if (Tcl_PkgProvide(interp, "Tktable", VERSION) != TCL_OK) {
3933 	return TCL_ERROR;
3934     }
3935     Tcl_CreateObjCommand(interp, TBL_COMMAND, Tk_TableObjCmd,
3936 			 (ClientData) Tk_MainWindow(interp),
3937 			 (Tcl_CmdDeleteProc *) NULL);
3938 
3939     /*
3940      * The init script can't make certain calls in a safe interpreter,
3941      * so we always have to use the embedded runtime for it
3942      */
3943     return Tcl_Eval(interp, Tcl_IsSafe(interp) ?
3944 	    tkTableSafeInitScript : tkTableInitScript);
3945 }
3946 
3947 EXTERN int
3948 Tktable_SafeInit(interp)
3949      Tcl_Interp *interp;
3950 {
3951     return Tktable_Init(interp);
3952 }
3953 #ifdef MAC_TCL
3954 #pragma export reset
3955 #endif
3956 #endif /* ifdef 0 */
3957 #ifdef WIN32
3958 /*
3959  *----------------------------------------------------------------------
3960  *
3961  * DllEntryPoint --
3962  *
3963  *	This wrapper function is used by Windows to invoke the
3964  *	initialization code for the DLL.  If we are compiling
3965  *	with Visual C++, this routine will be renamed to DllMain.
3966  *	routine.
3967  *
3968  * Results:
3969  *	Returns TRUE;
3970  *
3971  * Side effects:
3972  *	None.
3973  *
3974  *----------------------------------------------------------------------
3975  */
3976 
3977 BOOL APIENTRY
DllEntryPoint(hInst,reason,reserved)3978 DllEntryPoint(hInst, reason, reserved)
3979      HINSTANCE hInst;		/* Library instance handle. */
3980      DWORD reason;		/* Reason this function is being called. */
3981      LPVOID reserved;		/* Not used. */
3982 {
3983     return TRUE;
3984 }
3985 #endif
3986