1 /*
2  * tkTableCell.c --
3  *
4  *	This module implements cell oriented functions for table
5  *	widgets.
6  *
7  * Copyright (c) 1998-2000 Jeffrey Hobbs
8  *
9  * See the file "license.terms" for information on usage and redistribution
10  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
11  *
12  * RCS: @(#) $Id: tkTableCell.c,v 1.17 2004/02/08 03:09:46 cerney Exp $
13  */
14 
15 #include "tkVMacro.h"
16 #include "tkTable.h"
17 
18 static int	TableSortCompareProc _ANSI_ARGS_((CONST VOID *first,
19 						  CONST VOID *second));
20 
21 /*
22  *----------------------------------------------------------------------
23  *
24  * TableTrueCell --
25  *	Takes a row,col pair in user coords and returns the true
26  *	cell that it relates to, either dimension bounded, or a
27  *	span cell if it was hidden.
28  *
29  * Results:
30  *	The true row, col in user coords are placed in the pointers.
31  *	If the value changed for some reasons, 0 is returned (it was not
32  *	the /true/ cell).
33  *
34  * Side effects:
35  *	None.
36  *
37  *----------------------------------------------------------------------
38  */
39 int
TableTrueCell(Table * tablePtr,int r,int c,int * row,int * col)40 TableTrueCell(Table *tablePtr, int r, int c, int *row, int *col)
41 {
42     *row = r; *col = c;
43     /*
44      * We check spans before constraints, because we don't want to
45      * constrain and then think we ended up in a span
46      */
47     if (tablePtr->spanAffTbl && !(tablePtr->flags & AVOID_SPANS)) {
48 	char buf[INDEX_BUFSIZE];
49 	Tcl_HashEntry *entryPtr;
50 
51 	TableMakeArrayIndex(r, c, buf);
52 	entryPtr = Tcl_FindHashEntry(tablePtr->spanAffTbl, buf);
53 	if ((entryPtr != NULL) &&
54 		((char *)Tcl_GetHashValue(entryPtr) != NULL)) {
55 	    /*
56 	     * This cell is covered by another spanning cell.
57 	     * We need to return the coords for that spanning cell.
58 	     */
59 	    TableParseArrayIndex(row, col, (char *)Tcl_GetHashValue(entryPtr));
60 	    return 0;
61 	}
62     }
63     *row = BETWEEN(r, tablePtr->rowOffset,
64 	    tablePtr->rows-1+tablePtr->rowOffset);
65     *col = BETWEEN(c, tablePtr->colOffset,
66 	    tablePtr->cols-1+tablePtr->colOffset);
67     return ((*row == r) && (*col == c));
68 }
69 
70 /*
71  *----------------------------------------------------------------------
72  *
73  * TableCellCoords --
74  *	Takes a row,col pair in real coords and finds it position
75  *	on the virtual screen.
76  *
77  * Results:
78  *	The virtual x, y, width, and height of the cell
79  *	are placed in the pointers.
80  *
81  * Side effects:
82  *	None.
83  *
84  *----------------------------------------------------------------------
85  */
86 int
TableCellCoords(Table * tablePtr,int row,int col,int * x,int * y,int * w,int * h)87 TableCellCoords(Table *tablePtr, int row, int col,
88 		int *x, int *y, int *w, int *h)
89 {
90     register int hl = tablePtr->highlightWidth;
91     int result = CELL_OK;
92 
93     if (tablePtr->rows <= 0 || tablePtr->cols <= 0) {
94 	*w = *h = *x = *y = 0;
95 	return CELL_BAD;
96     }
97     /*
98      * Real coords required, always should be passed acceptable values,
99      * but this is a possible seg fault otherwise
100      */
101     CONSTRAIN(row, 0, tablePtr->rows-1);
102     CONSTRAIN(col, 0, tablePtr->cols-1);
103     *w = tablePtr->colPixels[col];
104     *h = tablePtr->rowPixels[row];
105     /*
106      * Adjust for sizes of spanning cells
107      * and ensure that this cell isn't "hidden"
108      */
109     if (tablePtr->spanAffTbl && !(tablePtr->flags & AVOID_SPANS)) {
110 	char buf[INDEX_BUFSIZE];
111 	Tcl_HashEntry *entryPtr;
112 
113 	TableMakeArrayIndex(row+tablePtr->rowOffset,
114 			    col+tablePtr->colOffset, buf);
115 	entryPtr = Tcl_FindHashEntry(tablePtr->spanAffTbl, buf);
116 	if (entryPtr != NULL) {
117 	    int rs, cs;
118 	    char *cell;
119 
120 	    cell = (char *) Tcl_GetHashValue(entryPtr);
121 	    if (cell != NULL) {
122 		/* This cell is covered by another spanning cell */
123 		/* We need to return the coords for that cell */
124 		TableParseArrayIndex(&rs, &cs, cell);
125 		*w = rs;
126 		*h = cs;
127 		result = CELL_HIDDEN;
128 		goto setxy;
129 	    }
130 	    /* Get the actual span values out of spanTbl */
131 	    entryPtr = Tcl_FindHashEntry(tablePtr->spanTbl, buf);
132 	    cell = (char *) Tcl_GetHashValue(entryPtr);
133 	    TableParseArrayIndex(&rs, &cs, cell);
134 	    if (rs > 0) {
135 		/*
136 		 * Make sure we don't overflow our space
137 		 */
138 		if (row < tablePtr->titleRows) {
139 		    rs = MIN(tablePtr->titleRows-1, row+rs);
140 		} else {
141 		    rs = MIN(tablePtr->rows-1, row+rs);
142 		}
143 		*h = tablePtr->rowStarts[rs+1]-tablePtr->rowStarts[row];
144 		result = CELL_SPAN;
145 	    } else if (rs <= 0) {
146 		/* currently negative spans are not supported */
147 	    }
148 	    if (cs > 0) {
149 		/*
150 		 * Make sure we don't overflow our space
151 		 */
152 		if (col < tablePtr->titleCols) {
153 		    cs = MIN(tablePtr->titleCols-1, col+cs);
154 		} else {
155 		    cs = MIN(tablePtr->cols-1, col+cs);
156 		}
157 		*w = tablePtr->colStarts[cs+1]-tablePtr->colStarts[col];
158 		result = CELL_SPAN;
159 	    } else if (cs <= 0) {
160 		/* currently negative spans are not supported */
161 	    }
162 	}
163     }
164 setxy:
165     *x = hl + tablePtr->colStarts[col];
166     if (col >= tablePtr->titleCols) {
167 	*x -= tablePtr->colStarts[tablePtr->leftCol]
168 	    - tablePtr->colStarts[tablePtr->titleCols];
169     }
170     *y = hl + tablePtr->rowStarts[row];
171     if (row >= tablePtr->titleRows) {
172 	*y -= tablePtr->rowStarts[tablePtr->topRow]
173 	    - tablePtr->rowStarts[tablePtr->titleRows];
174     }
175     return result;
176 }
177 
178 /*
179  *----------------------------------------------------------------------
180  *
181  * TableCellVCoords --
182  *	Takes a row,col pair in real coords and finds it position
183  *	on the actual screen.  The full arg specifies whether
184  *	only 100% visible cells should be considered visible.
185  *
186  * Results:
187  *	The x, y, width, and height of the cell are placed in the pointers,
188  *	depending upon visibility of the cell.
189  *	Returns 0 for hidden and 1 for visible cells.
190  *
191  * Side effects:
192  *	None.
193  *
194  *----------------------------------------------------------------------
195  */
196 int
TableCellVCoords(Table * tablePtr,int row,int col,int * rx,int * ry,int * rw,int * rh,int full)197 TableCellVCoords(Table *tablePtr, int row, int col,
198 		 int *rx, int *ry, int *rw, int *rh, int full)
199 {
200     int x, y, w, h, w0, h0, cellType, hl = tablePtr->highlightWidth;
201 
202     if (tablePtr->tkwin == NULL) return 0;
203 
204     /*
205      * Necessary to use separate vars in case dummies are passed in
206      */
207     cellType = TableCellCoords(tablePtr, row, col, &x, &y, &w, &h);
208     *rx = x; *ry = y; *rw = w; *rh = h;
209     if (cellType == CELL_OK) {
210 	if ((row < tablePtr->topRow && row >= tablePtr->titleRows) ||
211 	    (col < tablePtr->leftCol && col >= tablePtr->titleCols)) {
212 	    /*
213 	     * A non-spanning cell hiding in "dead" space
214 	     * between title areas and visible cells
215 	     */
216 	    return 0;
217 	}
218     } else if (cellType == CELL_SPAN) {
219 	/*
220 	 * we might need to treat full better is CELL_SPAN but primary
221 	 * cell is visible
222 	 */
223 	int topX = tablePtr->colStarts[tablePtr->titleCols]+hl;
224 	int topY = tablePtr->rowStarts[tablePtr->titleRows]+hl;
225 	if ((col < tablePtr->leftCol) && (col >= tablePtr->titleCols)) {
226 	    if (full || (x+w < topX)) {
227 		return 0;
228 	    } else {
229 		w -= topX-x;
230 		x = topX;
231 	    }
232 	}
233 	if ((row < tablePtr->topRow) && (row >= tablePtr->titleRows)) {
234 	    if (full || (y+h < topY)) {
235 		return 0;
236 	    } else {
237 		h -= topY-y;
238 		y = topY;
239 	    }
240 	}
241 	/*
242 	 * re-set these according to changed coords
243 	 */
244 	*rx = x; *ry = y; *rw = w; *rh = h;
245     } else {
246 	/*
247 	 * If it is a hidden cell, then w,h is the row,col in user coords
248 	 * of the cell that spans over this one
249 	 */
250 	return 0;
251     }
252     /*
253      * At this point, we know it is on the screen,
254      * but not if we can see 100% of it (if we care)
255      */
256     if (full) {
257 	w0 = w; h0 = h;
258     } else {
259 	/*
260 	 * if we don't care about seeing the whole thing, then
261 	 * make sure we at least see a pixel worth
262 	 */
263 	w0 = h0 = 1;
264     }
265     /*
266      * Is the cell visible?
267      */
268     if ((x < hl) || (y < hl) || ((x+w0) > (Tk_Width(tablePtr->tkwin)-hl))
269 	    || ((y+h0) > (Tk_Height(tablePtr->tkwin)-hl))) {
270 	/* definitely off the screen */
271 	return 0;
272     } else {
273 	/* if it was full, then w,h are already be properly constrained */
274 	if (!full) {
275 	    *rw = MIN(w, Tk_Width(tablePtr->tkwin)-hl-x);
276 	    *rh = MIN(h, Tk_Height(tablePtr->tkwin)-hl-y);
277 	}
278 	return 1;
279     }
280 }
281 
282 /*
283  *----------------------------------------------------------------------
284  *
285  * TableWhatCell --
286  *	Takes a x,y screen coordinate and determines what cell contains.
287  *	that point.  This will return cells that are beyond the right/bottom
288  *	edge of the viewable screen.
289  *
290  * Results:
291  *	The row,col of the cell are placed in the pointers.
292  *
293  * Side effects:
294  *	None.
295  *
296  *----------------------------------------------------------------------
297  */
298 void
TableWhatCell(register Table * tablePtr,int x,int y,int * row,int * col)299 TableWhatCell(register Table *tablePtr, int x, int y, int *row, int *col)
300 {
301     int i;
302     x = MAX(0, x); y = MAX(0, y);
303     /* Adjust for table's global highlightthickness border */
304     x -= tablePtr->highlightWidth;
305     y -= tablePtr->highlightWidth;
306     /* Adjust the x coord if not in the column titles to change display coords
307      * into internal coords */
308     x += (x < tablePtr->colStarts[tablePtr->titleCols]) ? 0 :
309 	tablePtr->colStarts[tablePtr->leftCol] -
310 	tablePtr->colStarts[tablePtr->titleCols];
311     y += (y < tablePtr->rowStarts[tablePtr->titleRows]) ? 0 :
312 	tablePtr->rowStarts[tablePtr->topRow] -
313 	tablePtr->rowStarts[tablePtr->titleRows];
314     x = MIN(x, tablePtr->maxWidth-1);
315     y = MIN(y, tablePtr->maxHeight-1);
316     for (i = 1; x >= tablePtr->colStarts[i]; i++);
317     *col = i - 1;
318     for (i = 1; y >= tablePtr->rowStarts[i]; i++);
319     *row = i - 1;
320     if (tablePtr->spanAffTbl && !(tablePtr->flags & AVOID_SPANS)) {
321 	char buf[INDEX_BUFSIZE];
322 	Tcl_HashEntry *entryPtr;
323 
324 	/* We now correct the returned cell if this was "hidden" */
325 	TableMakeArrayIndex(*row+tablePtr->rowOffset,
326 			    *col+tablePtr->colOffset, buf);
327 	entryPtr = Tcl_FindHashEntry(tablePtr->spanAffTbl, buf);
328 	if ((entryPtr != NULL) &&
329 	    /* We have to make sure this was not already hidden
330 	     * that's an error */
331 	    ((char *)Tcl_GetHashValue(entryPtr) != NULL)) {
332 	    /* this is a "hidden" cell */
333 	    TableParseArrayIndex(row, col, (char *)Tcl_GetHashValue(entryPtr));
334 	    *row -= tablePtr->rowOffset;
335 	    *col -= tablePtr->colOffset;
336 	}
337     }
338 }
339 
340 /*
341  *----------------------------------------------------------------------
342  *
343  * TableAtBorder --
344  *	Takes a x,y screen coordinate and determines if that point is
345  *	over a border.
346  *
347  * Results:
348  *	The left/top row,col corresponding to that point are placed in
349  *	the pointers.  The number of borders (+1 for row, +1 for col)
350  *	hit is returned.
351  *
352  * Side effects:
353  *	None.
354  *
355  *----------------------------------------------------------------------
356  */
357 int
TableAtBorder(Table * tablePtr,int x,int y,int * row,int * col)358 TableAtBorder(Table * tablePtr, int x, int y, int *row, int *col)
359 {
360     int i, brow, bcol, borders = 2, bd[6];
361 
362     TableGetTagBorders(&(tablePtr->defaultTag),
363 	    &bd[0], &bd[1], &bd[2], &bd[3]);
364     bd[4] = (bd[0] + bd[1])/2;
365     bd[5] = (bd[2] + bd[3])/2;
366 
367     /*
368      * Constrain x && y appropriately, and adjust x if it is not in the
369      * column titles to change display coords into internal coords.
370      */
371     x = MAX(0, x); y = MAX(0, y);
372     x -= tablePtr->highlightWidth; y -= tablePtr->highlightWidth;
373     x += (x < tablePtr->colStarts[tablePtr->titleCols]) ? 0 :
374 	tablePtr->colStarts[tablePtr->leftCol] -
375 	tablePtr->colStarts[tablePtr->titleCols];
376     x = MIN(x, tablePtr->maxWidth - 1);
377     for (i = 1; (i <= tablePtr->cols) &&
378 	     (x + (bd[0] + bd[1])) >= tablePtr->colStarts[i]; i++);
379     if (x > tablePtr->colStarts[--i] + bd[4]) {
380 	borders--;
381 	*col = -1;
382 	bcol = (i < tablePtr->leftCol && i >= tablePtr->titleCols) ?
383 	    tablePtr->titleCols-1 : i-1;
384     } else {
385 	bcol = *col = (i < tablePtr->leftCol && i >= tablePtr->titleCols) ?
386 	    tablePtr->titleCols-1 : i-1;
387     }
388     y += (y < tablePtr->rowStarts[tablePtr->titleRows]) ? 0 :
389 	tablePtr->rowStarts[tablePtr->topRow] -
390 	tablePtr->rowStarts[tablePtr->titleRows];
391     y = MIN(y, tablePtr->maxHeight - 1);
392     for (i = 1; i <= tablePtr->rows &&
393 	     (y + (bd[2] + bd[3])) >= tablePtr->rowStarts[i]; i++);
394     if (y > tablePtr->rowStarts[--i]+bd[5]) {
395 	borders--;
396 	*row = -1;
397 	brow = (i < tablePtr->topRow && i >= tablePtr->titleRows) ?
398 	    tablePtr->titleRows-1 : i-1;
399     } else {
400 	brow = *row = (i < tablePtr->topRow && i >= tablePtr->titleRows) ?
401 	    tablePtr->titleRows-1 : i-1;
402     }
403     /*
404      * We have to account for spanning cells, which may hide cells.
405      * In that case, we have to decrement our border count.
406      */
407     if (tablePtr->spanAffTbl && !(tablePtr->flags & AVOID_SPANS) && borders) {
408 	Tcl_HashEntry *entryPtr1, *entryPtr2 ;
409 	char buf1[INDEX_BUFSIZE], buf2[INDEX_BUFSIZE];
410 	char *val;
411 
412 	if (*row != -1) {
413 	    TableMakeArrayIndex(brow+tablePtr->rowOffset,
414 				bcol+tablePtr->colOffset+1, buf1);
415 	    TableMakeArrayIndex(brow+tablePtr->rowOffset+1,
416 				bcol+tablePtr->colOffset+1, buf2);
417 	    entryPtr1 = Tcl_FindHashEntry(tablePtr->spanAffTbl, buf1);
418 	    entryPtr2 = Tcl_FindHashEntry(tablePtr->spanAffTbl, buf2);
419 	    if (entryPtr1 != NULL && entryPtr2 != NULL) {
420 		if ((val = (char *) Tcl_GetHashValue(entryPtr1)) != NULL) {
421 		    strcpy(buf1, val);
422 		}
423 		if ((val = (char *) Tcl_GetHashValue(entryPtr2)) != NULL) {
424 		    strcpy(buf2, val);
425 		}
426 		if (strcmp(buf1, buf2) == 0) {
427 		    borders--;
428 		    *row = -1;
429 		}
430 	    }
431 	}
432 	if (*col != -1) {
433 	    TableMakeArrayIndex(brow+tablePtr->rowOffset+1,
434 				bcol+tablePtr->colOffset, buf1);
435 	    TableMakeArrayIndex(brow+tablePtr->rowOffset+1,
436 				bcol+tablePtr->colOffset+1, buf2);
437 	    entryPtr1 = Tcl_FindHashEntry(tablePtr->spanAffTbl, buf1);
438 	    entryPtr2 = Tcl_FindHashEntry(tablePtr->spanAffTbl, buf2);
439 	    if (entryPtr1 != NULL && entryPtr2 != NULL) {
440 		if ((val = (char *) Tcl_GetHashValue(entryPtr1)) != NULL) {
441 		    strcpy(buf1, val);
442 		}
443 		if ((val = (char *) Tcl_GetHashValue(entryPtr2)) != NULL) {
444 		    strcpy(buf2, val);
445 		}
446 		if (strcmp(buf1, buf2) == 0) {
447 		    borders--;
448 		    *col = -1;
449 		}
450 	    }
451 	}
452     }
453     return borders;
454 }
455 
456 /*
457  *----------------------------------------------------------------------
458  *
459  * TableGetCellValue --
460  *	Takes a row,col pair in user coords and returns the value for
461  *	that cell.  This varies depending on what data source the
462  *	user has selected.
463  *
464  * Results:
465  *	The value of the cell is returned.  The return value is VOLATILE
466  *	(do not free).
467  *
468  * Side effects:
469  *	The value will be cached if caching is turned on.
470  *
471  *----------------------------------------------------------------------
472  */
473 char *
TableGetCellValue(Table * tablePtr,int r,int c)474 TableGetCellValue(Table *tablePtr, int r, int c)
475 {
476     register Tcl_Interp *interp = tablePtr->interp;
477     char *result = NULL;
478     char buf[INDEX_BUFSIZE];
479     Tcl_HashEntry *entryPtr = NULL;
480     int new = 1;
481     TableMakeArrayIndex(r, c, buf);
482 
483     if (tablePtr->caching) {
484 	/*
485 	 * If we are caching, let's see if we have the value cached
486 	 */
487 	entryPtr = Tcl_CreateHashEntry(tablePtr->cache, buf, &new);
488 	if (!new) {
489 	    result = (char *) Tcl_GetHashValue(entryPtr);
490 	    if (result == NULL) {
491 		result = "";
492 	    }
493 	    goto VALUE;
494 	}
495     }
496     if (tablePtr->command && tablePtr->useCmd) {
497 
498 	if (LangDoCallback(interp, tablePtr->command, 1, 3, "%d %d %d",0,r,c) == TCL_ERROR) {
499 	    tablePtr->useCmd = 0;
500 	    tablePtr->dataSource &= ~DATA_COMMAND;
501 	    if (tablePtr->arrayVar)
502 		tablePtr->dataSource |= DATA_ARRAY;
503 	    Tcl_AddErrorInfo(interp, "\n\t(in -command evaled by table)");
504 	    Tcl_BackgroundError(interp);
505 	    TableInvalidateAll(tablePtr, 0);
506 	} else {
507 	    result = (char *) Tcl_GetStringFromObj(Tcl_GetObjResult(interp),NULL);
508 	}
509 	/* Tcl_FreeResult(interp); not support for perl/tk */
510     } else if (tablePtr->arrayVar) {
511 	result = Tcl_GetString(Tcl_ObjGetVar2(interp, tablePtr->arrayVar, Tcl_NewStringObj(buf,-1),
512 	        TCL_GLOBAL_ONLY));
513     }
514     if (result == NULL)
515 	result = "";
516     if (tablePtr->caching && entryPtr != NULL) {
517 	/*
518 	 * If we are caching, make sure we cache the returned value
519 	 *
520 	 * entryPtr will have been set from above, but check to make sure
521 	 * someone didn't change caching during -command evaluation.
522 	 */
523 	char *val;
524 	val = (char *)ckalloc(strlen(result)+1);
525 	strcpy(val, result);
526 	Tcl_SetHashValue(entryPtr, val);
527     }
528 VALUE:
529 #ifdef PROCS
530     if (result != NULL) {
531 	/* Do we have procs, are we showing their value, is this a proc? */
532 	if (tablePtr->hasProcs && !tablePtr->showProcs && *result == '=' &&
533 	    !(r-tablePtr->rowOffset == tablePtr->activeRow &&
534 	      c-tablePtr->colOffset == tablePtr->activeCol)) {
535 	    Tcl_DString script;
536 	    /* provides a rough mutex on preventing proc loops */
537 	    entryPtr = Tcl_CreateHashEntry(tablePtr->inProc, buf, &new);
538 	    if (!new) {
539 		Tcl_SetHashValue(entryPtr, 1);
540 		Tcl_AddErrorInfo(interp, "\n\t(loop hit in proc evaled by table)");
541 		return result;
542 	    }
543 	    Tcl_SetHashValue(entryPtr, 0);
544 	    Tcl_DStringInit(&script);
545 	    ExpandPercents(tablePtr, result+1, r, c, result+1, (char *)NULL,
546 			   0, &script, 0);
547 	    if (Tcl_GlobalEval(interp, Tcl_DStringValue(&script)) != TCL_OK ||
548 		Tcl_GetHashValue(entryPtr) == 1) {
549 		Tcl_AddErrorInfo(interp, "\n\tin proc evaled by table:\n");
550 		Tcl_AddErrorInfo(interp, Tcl_DStringValue(&script));
551 		Tcl_BackgroundError(interp);
552 	    } else {
553 		result = Tcl_GetResult(interp);
554 	    }
555 	    /* Tcl_FreeResult(interp); Not Supported for perl/tk */
556 	    Tcl_DStringFree(&script);
557 	    Tcl_DeleteHashEntry(entryPtr);
558 	}
559     }
560 #endif
561     return (result?result:"");
562 }
563 
564 /*
565  *----------------------------------------------------------------------
566  *
567  * TableSetCellValue --
568  *	Takes a row,col pair in user coords and saves the given value for
569  *	that cell.  This varies depending on what data source the
570  *	user has selected.
571  *
572  * Results:
573  *	Returns TCL_ERROR or TCL_OK, depending on whether an error
574  *	occured during set (ie: during evaluation of -command).
575  *
576  * Side effects:
577  *	If the value is NULL (empty string), it will be unset from
578  *	an array rather than set to the empty string.
579  *
580  *----------------------------------------------------------------------
581  */
582 int
TableSetCellValue(Table * tablePtr,int r,int c,char * value)583 TableSetCellValue(Table *tablePtr, int r, int c, char *value)
584 {
585     register Tcl_Interp *interp = tablePtr->interp;
586     char buf[INDEX_BUFSIZE];
587     int code = TCL_OK, flash = 0;
588 
589     TableMakeArrayIndex(r, c, buf);
590 
591     if (tablePtr->state == STATE_DISABLED) {
592 	return TCL_OK;
593     }
594     if (tablePtr->command && tablePtr->useCmd) {
595 	if (LangDoCallback(interp, tablePtr->command, 1, 4, "%d %d %d %_",1,r,c, LangStringArg(value)) == TCL_ERROR) {
596 	    /* An error resulted.  Prevent further triggering of the command
597 	     * and set up the error message. */
598 	    tablePtr->useCmd = 0;
599 	    tablePtr->dataSource &= ~DATA_COMMAND;
600 	    if (tablePtr->arrayVar)
601 		tablePtr->dataSource |= DATA_ARRAY;
602 	    Tcl_AddErrorInfo(interp, "\n\t(in command executed by table)");
603 	    Tcl_BackgroundError(interp);
604 	    code = TCL_ERROR;
605 	} else {
606 	    flash = 1;
607 	}
608 	Tcl_SetResult(interp, (char *) NULL, TCL_STATIC);
609     } else if (tablePtr->arrayVar) {
610 	/* Warning: checking for \0 as the first char could invalidate
611 	 * allowing it as a valid first char */
612 	if ((value == NULL || *value == '\0') && tablePtr->sparse) {
613 	    /* perltk not supported  */
614 	    /* Tcl_UnsetVar2(interp, LangString(Tcl_GetVar(interp, tablePtr->arrayVar, TCL_GLOBAL_ONLY)), buf, TCL_GLOBAL_ONLY); */
615 	    /* Replaced with This (defined in tkTable.xs) */
616 	    tkTableUnsetElement(tablePtr->arrayVar, buf);
617 	} else if (Tcl_ObjSetVar2(interp, tablePtr->arrayVar, Tcl_NewStringObj(buf,-1), Tcl_NewStringObj(value,-1),
618 			       TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
619 	    code = TCL_ERROR;
620 	}
621     }
622     if (code == TCL_ERROR) {
623 	return TCL_ERROR;
624     }
625 
626     if (tablePtr->caching) {
627 	Tcl_HashEntry *entryPtr;
628 	int new;
629 	char *val;
630 
631 	entryPtr = Tcl_CreateHashEntry(tablePtr->cache, buf, &new);
632 	if (!new) {
633 	    val = (char *) Tcl_GetHashValue(entryPtr);
634 	    if (val) ckfree(val);
635 	}
636 	val = (char *)ckalloc(strlen(value)+1);
637 	strcpy(val, value);
638 	Tcl_SetHashValue(entryPtr, val);
639 	flash = 1;
640     }
641     /* We do this conditionally because the var array already has
642      * it's own check to flash */
643     if (flash && tablePtr->flashMode) {
644 	r -= tablePtr->rowOffset;
645 	c -= tablePtr->colOffset;
646 	TableAddFlash(tablePtr, r, c);
647 	TableRefresh(tablePtr, r, c, CELL);
648     }
649     return TCL_OK;
650 }
651 
652 /*
653  *----------------------------------------------------------------------
654  *
655  * TableMoveCellValue --
656  *	To move cells faster on delete/insert line or col when cache is on
657  *	and variable, command is off.
658  *	To avoid another call to TableMakeArrayIndex(r, c, buf),
659  *	we optionally provide the buffers.
660  *	outOfBounds means we will just set the cell value to ""
661  *
662  * Results:
663  *	Returns TCL_ERROR or TCL_OK, depending on whether an error
664  *	occured during set (ie: during evaluation of -command).
665  *
666  * Side effects:
667  *	If the value is NULL (empty string), it will be unset from
668  *	an array rather than set to the empty string.
669  *
670  *----------------------------------------------------------------------
671  */
672 int
TableMoveCellValue(Table * tablePtr,int fromr,int fromc,char * frombuf,int tor,int toc,char * tobuf,int outOfBounds)673 TableMoveCellValue(Table *tablePtr, int fromr, int fromc, char *frombuf,
674 	int tor, int toc, char *tobuf, int outOfBounds)
675 {
676     int new;
677     char *result = NULL;
678     Tcl_Interp *interp = tablePtr->interp;
679 
680     if (outOfBounds) {
681 	return TableSetCellValue(tablePtr, tor, toc, "");
682     }
683 
684     if (tablePtr->caching && (!(tablePtr->command && tablePtr->useCmd))) {
685 	Tcl_HashEntry *entryPtr;
686 	/*
687 	 * if we are caching, let's see if we have the value cached
688 	 */
689 	entryPtr = Tcl_CreateHashEntry(tablePtr->cache, frombuf, &new);
690 	if (!new) {
691 	    char *val;
692 	    result = (char *) Tcl_GetHashValue(entryPtr);
693 	    /*
694 	     * we set tho old value to NULL
695 	     */
696 	    Tcl_SetHashValue(entryPtr, NULL);
697 
698 	    /*
699 	     * set the destination to the source pointer without new mallocing!
700 	     */
701 	    entryPtr = Tcl_CreateHashEntry(tablePtr->cache, tobuf, &new);
702 	    /*
703 	     * free old value
704 	     */
705 	    if (!new) {
706 		val = (char *) Tcl_GetHashValue(entryPtr);
707 		if (val) ckfree(val);
708 	    }
709 	    Tcl_SetHashValue(entryPtr, result);
710 	    if (tablePtr->arrayVar) {
711 		/*
712 		 * first, delete from var.
713 		 */
714 		/* perltk not supported  */
715 		/*Tcl_UnsetVar2(interp, tablePtr->arrayVar, frombuf,
716 			TCL_GLOBAL_ONLY);
717 		*/
718 		/* Replaced with This (defined in tkTable.xs) */
719 		tkTableUnsetElement(tablePtr->arrayVar, frombuf);
720 		/*
721 		 * Warning: checking for \0 as the first char could invalidate
722 		 * allowing it as a valid first char
723 		 */
724 		if (Tcl_ObjSetVar2(interp, tablePtr->arrayVar, Tcl_NewStringObj(tobuf,-1), Tcl_NewStringObj(result, -1),
725 			TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
726 		    return TCL_ERROR;
727 		}
728 	    }
729 
730 
731 	    return TCL_OK;
732 	}
733     }
734     /*
735      * We have to do it the old way
736      */
737     return TableSetCellValue(tablePtr, tor, toc,
738 	    TableGetCellValue(tablePtr, fromr, fromc));
739 
740 }
741 
742 /*
743  *----------------------------------------------------------------------
744  *
745  * TableGetIcursor --
746  *	Parses the argument as an index into the active cell string.
747  *	Recognises 'end', 'insert' or an integer.  Constrains it to the
748  *	size of the buffer.  This acts like a "SetIcursor" when *posn is NULL.
749  *
750  * Results:
751  *	If (posn != NULL), then it gets the cursor position.
752  *
753  * Side effects:
754  *	Can move cursor position.
755  *
756  *----------------------------------------------------------------------
757  */
758 int
TableGetIcursor(Table * tablePtr,char * arg,int * posn)759 TableGetIcursor(Table *tablePtr, char *arg, int *posn)
760 {
761     int tmp, len;
762 
763     len = strlen(tablePtr->activeBuf);
764 #ifdef TCL_UTF_MAX
765     /* Need to base it off strlen to account for \x00 (Unicode null) */
766     len = Tcl_NumUtfChars(tablePtr->activeBuf, len);
767 #endif
768     /* ensure icursor didn't get out of sync */
769     if (tablePtr->icursor > len) tablePtr->icursor = len;
770     /* is this end */
771     if (strcmp(arg, "end") == 0) {
772 	tmp = len;
773     } else if (strcmp(arg, "insert") == 0) {
774 	tmp = tablePtr->icursor;
775     } else {
776 	if (Tcl_GetIntFromObj(tablePtr->interp, LangStringArg(arg), &tmp) != TCL_OK) {
777 	    return TCL_ERROR;
778 	}
779 	CONSTRAIN(tmp, 0, len);
780     }
781     if (posn) {
782 	*posn = tmp;
783     } else {
784 	tablePtr->icursor = tmp;
785     }
786     return TCL_OK;
787 }
788 
789 /*
790  *--------------------------------------------------------------
791  *
792  * TableGetIndex --
793  *	Parse an index into a table and return either its value
794  *	or an error.
795  *
796  * Results:
797  *	A standard Tcl result.  If all went well, then *row,*col is
798  *	filled in with the index corresponding to string.  If an
799  *	error occurs then an error message is left in interp result.
800  *	The index returned is in user coords.
801  *
802  * Side effects:
803  *	Sets row,col index to an appropriately constrained user index.
804  *
805  *--------------------------------------------------------------
806  */
807 int
TableGetIndex(tablePtr,str,row_p,col_p)808 TableGetIndex(tablePtr, str, row_p, col_p)
809     register Table *tablePtr;	/* Table for which the index is being
810 				 * specified. */
811     char *str;			/* Symbolic specification of cell in table. */
812     int *row_p;		/* Where to store converted row. */
813     int *col_p;		/* Where to store converted col. */
814 {
815     int r, c, len = strlen(str);
816     char dummy;
817 
818     /*
819      * Note that all of these values will be adjusted by row/ColOffset
820      */
821     if (str[0] == '@') {	/* @x,y coordinate */
822 	int x, y;
823 
824 	if (sscanf(str+1, "%d,%d%c", &x, &y, &dummy) != 2) {
825 	    /* Make sure it won't work for "2,3extrastuff" */
826 	    goto IndexError;
827 	}
828 	TableWhatCell(tablePtr, x, y, &r, &c);
829 	r += tablePtr->rowOffset;
830 	c += tablePtr->colOffset;
831     } else if (*str == '-' || isdigit(str[0])) {
832 	if (sscanf(str, "%d,%d%c", &r, &c, &dummy) != 2) {
833 	    /* Make sure it won't work for "2,3extrastuff" */
834 	    goto IndexError;
835 	}
836 	/* ensure appropriate user index */
837 	CONSTRAIN(r, tablePtr->rowOffset,
838 		tablePtr->rows-1+tablePtr->rowOffset);
839 	CONSTRAIN(c, tablePtr->colOffset,
840 		tablePtr->cols-1+tablePtr->colOffset);
841     } else if (len > 1 && strncmp(str, "active", len) == 0 ) {	/* active */
842 	if (tablePtr->flags & HAS_ACTIVE) {
843 	    r = tablePtr->activeRow+tablePtr->rowOffset;
844 	    c = tablePtr->activeCol+tablePtr->colOffset;
845 	} else {
846 	    Tcl_SetStringObj(Tcl_GetObjResult(tablePtr->interp),
847 			     "no \"active\" cell in table", -1);
848 	    return TCL_ERROR;
849 	}
850     } else if (len > 1 && strncmp(str, "anchor", len) == 0) {	/* anchor */
851 	if (tablePtr->flags & HAS_ANCHOR) {
852 	    r = tablePtr->anchorRow+tablePtr->rowOffset;
853 	    c = tablePtr->anchorCol+tablePtr->colOffset;
854 	} else {
855 	    Tcl_SetStringObj(Tcl_GetObjResult(tablePtr->interp),
856 			     "no \"anchor\" cell in table", -1);
857 	    return TCL_ERROR;
858 	}
859     } else if (strncmp(str, "end", len) == 0) {		/* end */
860 	r = tablePtr->rows-1+tablePtr->rowOffset;
861 	c = tablePtr->cols-1+tablePtr->colOffset;
862     } else if (strncmp(str, "origin", len) == 0) {	/* origin */
863 	r = tablePtr->titleRows+tablePtr->rowOffset;
864 	c = tablePtr->titleCols+tablePtr->colOffset;
865     } else if (strncmp(str, "topleft", len) == 0) {	/* topleft */
866 	r = tablePtr->topRow+tablePtr->rowOffset;
867 	c = tablePtr->leftCol+tablePtr->colOffset;
868     } else if (strncmp(str, "bottomright", len) == 0) {	/* bottomright */
869 	/*
870 	 * FIX: Should this avoid spans, or consider them in the bottomright?
871 	 tablePtr->flags |= AVOID_SPANS;
872 	 tablePtr->flags &= ~AVOID_SPANS;
873 	 */
874 	TableGetLastCell(tablePtr, &r, &c);
875 	r += tablePtr->rowOffset;
876 	c += tablePtr->colOffset;
877     } else {
878     IndexError:
879 	Tcl_AppendStringsToObj(Tcl_GetObjResult(tablePtr->interp),
880 		"bad table index \"", str, "\": must be active, anchor, end, ",
881 		"origin, topleft, bottomright, @x,y, or <row>,<col>",
882 		(char *)NULL);
883 	return TCL_ERROR;
884     }
885 
886     /* Note: values are expected to be properly constrained
887      * as a user index by this point */
888     if (row_p) *row_p = r;
889     if (col_p) *col_p = c;
890     return TCL_OK;
891 }
892 
893 /*
894  *--------------------------------------------------------------
895  *
896  * Table_SetCmd --
897  *	This procedure is invoked to process the set method
898  *	that corresponds to a widget managed by this module.
899  *	See the user documentation for details on what it does.
900  *
901  * Results:
902  *	A standard Tcl result.
903  *
904  * Side effects:
905  *	See the user documentation.
906  *
907  *--------------------------------------------------------------
908  */
909 int
Table_SetCmd(ClientData clientData,register Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])910 Table_SetCmd(ClientData clientData, register Tcl_Interp *interp,
911 	     int objc, Tcl_Obj *CONST objv[])
912 {
913     register Table *tablePtr = (Table *)clientData;
914     int row, col, len, i, j, max;
915     char *str;
916 
917     /* sets any number of tags/indices to a given value */
918     if (objc < 3) {
919     CMD_SET_USAGE:
920 	Tcl_WrongNumArgs(interp, 2, objv,
921 			 "?row|col? index ?value? ?index value ...?");
922 	return TCL_ERROR;
923     }
924 
925     /* make sure there is a data source to accept set */
926     if (tablePtr->dataSource == DATA_NONE) {
927 	return TCL_OK;
928     }
929 
930     str = Tcl_GetStringFromObj(objv[2], &len);
931     if (strncmp(str, "row", len) == 0 || strncmp(str, "col", len) == 0) {
932 	Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
933 	/* set row index list ?index list ...? */
934 	if (objc < 4) {
935 	    goto CMD_SET_USAGE;
936 	} else if (objc == 4) {
937 	    if (TableGetIndexObj(tablePtr, objv[3],
938 				 &row, &col) != TCL_OK) {
939 		return TCL_ERROR;
940 	    }
941 	    if (*str == 'r') {
942 		max = tablePtr->cols+tablePtr->colOffset;
943 		for (i=col; i<max; i++) {
944 		    str = TableGetCellValue(tablePtr, row, i);
945 		    Tcl_ListObjAppendElement(NULL, resultPtr,
946 					     Tcl_NewStringObj(str, -1));
947 		}
948 	    } else {
949 		max = tablePtr->rows+tablePtr->rowOffset;
950 		for (i=row; i<max; i++) {
951 		    str = TableGetCellValue(tablePtr, i, col);
952 		    Tcl_ListObjAppendElement(NULL, resultPtr,
953 					     Tcl_NewStringObj(str, -1));
954 		}
955 	    }
956 	} else if (tablePtr->state == STATE_NORMAL) {
957 	    int listc;
958 	    Tcl_Obj **listv;
959 	    /* make sure there are an even number of index/list pairs */
960 	    if (objc & 0) {
961 		goto CMD_SET_USAGE;
962 	    }
963 	    for (i = 3; i < objc-1; i += 2) {
964 		if ((TableGetIndexObj(tablePtr, objv[i],
965 				      &row, &col) != TCL_OK) ||
966 		    (Tcl_ListObjGetElements(interp, objv[i+1],
967 					    &listc, &listv) != TCL_OK)) {
968 		    return TCL_ERROR;
969 		}
970 		if (*str == 'r') {
971 		    max = col+MIN(tablePtr->cols+tablePtr->colOffset-col,
972 				  listc);
973 		    for (j = col; j < max; j++) {
974 			if (TableSetCellValue(tablePtr, row, j,
975 					      Tcl_GetString(listv[j-col]))
976 			    != TCL_OK) {
977 			    return TCL_ERROR;
978 			}
979 			if (row-tablePtr->rowOffset == tablePtr->activeRow &&
980 			    j-tablePtr->colOffset == tablePtr->activeCol) {
981 			    TableGetActiveBuf(tablePtr);
982 			}
983 			TableRefresh(tablePtr, row-tablePtr->rowOffset,
984 				     j-tablePtr->colOffset, CELL);
985 		    }
986 		} else {
987 		    max = row+MIN(tablePtr->rows+tablePtr->rowOffset-row,
988 				  listc);
989 		    for (j = row; j < max; j++) {
990 			if (TableSetCellValue(tablePtr, j, col,
991 					      Tcl_GetString(listv[j-row]))
992 			    != TCL_OK) {
993 			    return TCL_ERROR;
994 			}
995 			if (j-tablePtr->rowOffset == tablePtr->activeRow &&
996 			    col-tablePtr->colOffset == tablePtr->activeCol) {
997 			    TableGetActiveBuf(tablePtr);
998 			}
999 			TableRefresh(tablePtr, j-tablePtr->rowOffset,
1000 				     col-tablePtr->colOffset, CELL);
1001 		    }
1002 		}
1003 	    }
1004 	}
1005     } else if (objc == 3) {
1006 	/* set index */
1007 	if (TableGetIndexObj(tablePtr, objv[2], &row, &col) != TCL_OK) {
1008 	    return TCL_ERROR;
1009 	} else {
1010 	    /*
1011 	     * Cannot use Tcl_GetObjResult here because TableGetCellValue
1012 	     * can corrupt the resultPtr.
1013 	     */
1014 	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
1015 		TableGetCellValue(tablePtr, row, col),-1));
1016 	}
1017     } else {
1018 	/* set index val ?index val ...? */
1019 	/* make sure there are an even number of index/value pairs */
1020 	if (objc & 1) {
1021 	    goto CMD_SET_USAGE;
1022 	}
1023 	for (i = 2; i < objc-1; i += 2) {
1024 	    if ((TableGetIndexObj(tablePtr, objv[i], &row, &col) != TCL_OK) ||
1025 		(TableSetCellValue(tablePtr, row, col,
1026 				   Tcl_GetString(objv[i+1])) != TCL_OK)) {
1027 		return TCL_ERROR;
1028 	    }
1029 	    row -= tablePtr->rowOffset;
1030 	    col -= tablePtr->colOffset;
1031 	    if (row == tablePtr->activeRow && col == tablePtr->activeCol) {
1032 		TableGetActiveBuf(tablePtr);
1033 	    }
1034 	    TableRefresh(tablePtr, row, col, CELL);
1035 	}
1036     }
1037     return TCL_OK;
1038 }
1039 
1040 /*
1041  *--------------------------------------------------------------
1042  *
1043  * Table_SpanSet --
1044  *	Takes row,col in user coords and sets a span on the
1045  *	cell if possible
1046  *
1047  * Results:
1048  *	A standard Tcl result
1049  *
1050  * Side effects:
1051  *	The span can be constrained
1052  *
1053  *--------------------------------------------------------------
1054  */
1055 static int
Table_SpanSet(register Table * tablePtr,int urow,int ucol,int rs,int cs)1056 Table_SpanSet(register Table *tablePtr, int urow, int ucol, int rs, int cs)
1057 {
1058     Tcl_Interp *interp = tablePtr->interp;
1059     int i, j, new, ors, ocs, result = TCL_OK;
1060     int row, col;
1061     Tcl_HashEntry *entryPtr;
1062     Tcl_HashSearch search;
1063     char *dbuf, buf[INDEX_BUFSIZE], cell[INDEX_BUFSIZE], span[INDEX_BUFSIZE];
1064 
1065     row = urow - tablePtr->rowOffset;
1066     col = ucol - tablePtr->colOffset;
1067 
1068     TableMakeArrayIndex(urow, ucol, cell);
1069 
1070     if (tablePtr->spanTbl == NULL) {
1071 	tablePtr->spanTbl = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
1072 	Tcl_InitHashTable(tablePtr->spanTbl, TCL_STRING_KEYS);
1073 	tablePtr->spanAffTbl = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
1074 	Tcl_InitHashTable(tablePtr->spanAffTbl, TCL_STRING_KEYS);
1075     }
1076 
1077     /* first check in the affected cells table */
1078     if ((entryPtr=Tcl_FindHashEntry(tablePtr->spanAffTbl, cell)) != NULL) {
1079 	/* We have to make sure this was not already hidden
1080 	 * that's an error */
1081 	if ((char *)Tcl_GetHashValue(entryPtr) != NULL) {
1082 	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
1083 				   "cannot set spanning on hidden cell ",
1084 				   cell, (char *) NULL);
1085 	    return TCL_ERROR;
1086 	}
1087     }
1088     /* do constraints on the spans
1089      * title cells must not expand beyond the titles
1090      * other cells can't expand negatively into title area
1091      */
1092     if ((row < tablePtr->titleRows) &&
1093 	(row + rs >= tablePtr->titleRows)) {
1094 	rs = tablePtr->titleRows - row - 1;
1095     }
1096     if ((col < tablePtr->titleCols) &&
1097 	(col + cs >= tablePtr->titleCols)) {
1098 	cs = tablePtr->titleCols - col - 1;
1099     }
1100     rs = MAX(0, rs);
1101     cs = MAX(0, cs);
1102 
1103     /* then work in the span cells table */
1104     if ((entryPtr = Tcl_FindHashEntry(tablePtr->spanTbl, cell)) != NULL) {
1105 	/* We have to readjust for what was there first */
1106 	TableParseArrayIndex(&ors, &ocs, (char *)Tcl_GetHashValue(entryPtr));
1107 	ckfree((char *) Tcl_GetHashValue(entryPtr));
1108 	Tcl_DeleteHashEntry(entryPtr);
1109 	for (i = urow; i <= urow+ors; i++) {
1110 	    for (j = ucol; j <= ucol+ocs; j++) {
1111 		TableMakeArrayIndex(i, j, buf);
1112 		entryPtr = Tcl_FindHashEntry(tablePtr->spanAffTbl, buf);
1113 		if (entryPtr != NULL) {
1114 		    Tcl_DeleteHashEntry(entryPtr);
1115 		}
1116 		TableRefresh(tablePtr, i-tablePtr->rowOffset,
1117 			     j-tablePtr->colOffset, CELL);
1118 	    }
1119 	}
1120     } else {
1121 	ors = ocs = 0;
1122     }
1123 
1124     /* calc to make sure that span is OK */
1125     for (i = urow; i <= urow+rs; i++) {
1126 	for (j = ucol; j <= ucol+cs; j++) {
1127 	    TableMakeArrayIndex(i, j, buf);
1128 	    entryPtr = Tcl_FindHashEntry(tablePtr->spanAffTbl, buf);
1129 	    if (entryPtr != NULL) {
1130 		/* Something already spans here */
1131 		Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
1132 				       "cannot overlap already spanned cell ",
1133 				       buf, (char *) NULL);
1134 		result = TCL_ERROR;
1135 		rs = ors;
1136 		cs = ocs;
1137 		break;
1138 	    }
1139 	}
1140 	if (result == TCL_ERROR)
1141 	    break;
1142     }
1143 
1144     /* 0,0 span means set to unspanned again */
1145     if (rs == 0 && cs == 0) {
1146 	entryPtr = Tcl_FindHashEntry(tablePtr->spanTbl, cell);
1147 	if (entryPtr != NULL) {
1148 	    ckfree((char *) Tcl_GetHashValue(entryPtr));
1149 	    Tcl_DeleteHashEntry(entryPtr);
1150 	}
1151 	entryPtr = Tcl_FindHashEntry(tablePtr->spanAffTbl, cell);
1152 	if (entryPtr != NULL) {
1153 	    Tcl_DeleteHashEntry(entryPtr);
1154 	}
1155 	if (Tcl_FirstHashEntry(tablePtr->spanTbl, &search) == NULL) {
1156 	    /* There are no more spans, so delete tables to improve
1157 	     * performance of TableCellCoords */
1158 	    Tcl_DeleteHashTable(tablePtr->spanTbl);
1159 	    ckfree((char *) (tablePtr->spanTbl));
1160 	    Tcl_DeleteHashTable(tablePtr->spanAffTbl);
1161 	    ckfree((char *) (tablePtr->spanAffTbl));
1162 	    tablePtr->spanTbl = NULL;
1163 	    tablePtr->spanAffTbl = NULL;
1164 	}
1165 	return result;
1166     }
1167 
1168     /* Make sure there is no extra stuff */
1169     TableMakeArrayIndex(rs, cs, span);
1170 
1171     /* Set affected cell table to a NULL value */
1172     entryPtr = Tcl_CreateHashEntry(tablePtr->spanAffTbl, cell, &new);
1173     Tcl_SetHashValue(entryPtr, (char *) NULL);
1174     /* set the spanning cells table with span value */
1175     entryPtr = Tcl_CreateHashEntry(tablePtr->spanTbl, cell, &new);
1176     dbuf = (char *)ckalloc(strlen(span)+1);
1177     strcpy(dbuf, span);
1178     Tcl_SetHashValue(entryPtr, dbuf);
1179     dbuf = Tcl_GetHashKey(tablePtr->spanTbl, entryPtr);
1180     /* Set other affected cells */
1181     EmbWinUnmap(tablePtr, row, row + rs, col, col + cs);
1182     for (i = urow; i <= urow+rs; i++) {
1183 	for (j = ucol; j <= ucol+cs; j++) {
1184 	    TableMakeArrayIndex(i, j, buf);
1185 	    entryPtr = Tcl_CreateHashEntry(tablePtr->spanAffTbl, buf, &new);
1186 	    if (!(i == urow && j == ucol)) {
1187 		Tcl_SetHashValue(entryPtr, (char *) dbuf);
1188 	    }
1189 	}
1190     }
1191     TableRefresh(tablePtr, row, col, CELL);
1192     return result;
1193 }
1194 
1195 /*
1196  *--------------------------------------------------------------
1197  *
1198  * Table_SpanCmd --
1199  *	This procedure is invoked to process the span method
1200  *	that corresponds to a widget managed by this module.
1201  *	See the user documentation for details on what it does.
1202  *
1203  * Results:
1204  *	A standard Tcl result.
1205  *
1206  * Side effects:
1207  *	See the user documentation.
1208  *
1209  *--------------------------------------------------------------
1210  */
1211 int
Table_SpanCmd(ClientData clientData,register Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1212 Table_SpanCmd(ClientData clientData, register Tcl_Interp *interp,
1213 	      int objc, Tcl_Obj *CONST objv[])
1214 {
1215     register Table *tablePtr = (Table *) clientData;
1216     int rs, cs, row, col, i;
1217     Tcl_HashEntry *entryPtr;
1218     Tcl_Obj *objPtr, *resultPtr;
1219 
1220     if (objc < 2 || (objc > 4 && (objc&1))) {
1221 	Tcl_WrongNumArgs(interp, 2, objv,
1222 			 "?index? ?rows,cols index rows,cols ...?");
1223 	return TCL_ERROR;
1224     }
1225 
1226     resultPtr = Tcl_GetObjResult(interp);
1227 
1228     if (objc == 2) {
1229 	if (tablePtr->spanTbl) {
1230 	    Tcl_HashSearch search;
1231 
1232 	    for (entryPtr = Tcl_FirstHashEntry(tablePtr->spanTbl, &search);
1233 		 entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&search)) {
1234 		objPtr = Tcl_NewStringObj(Tcl_GetHashKey(tablePtr->spanTbl,
1235 							 entryPtr), -1);
1236 		Tcl_ListObjAppendElement(NULL, resultPtr, objPtr);
1237 		objPtr = Tcl_NewStringObj((char *) Tcl_GetHashValue(entryPtr),
1238 					  -1);
1239 		Tcl_ListObjAppendElement(NULL, resultPtr, objPtr);
1240 	    }
1241 	}
1242 	return TCL_OK;
1243     } else if (objc == 3) {
1244 	if (TableGetIndexObj(tablePtr, objv[2], &row, &col) == TCL_ERROR) {
1245 	    return TCL_ERROR;
1246 	}
1247 	/* Just return the spanning values of the one cell */
1248 	if (tablePtr->spanTbl &&
1249 	    (entryPtr = Tcl_FindHashEntry(tablePtr->spanTbl,
1250 					  Tcl_GetString(objv[2]))) != NULL) {
1251 	    Tcl_SetStringObj(resultPtr,
1252 			     (char *)Tcl_GetHashValue(entryPtr), -1);
1253 	}
1254 	return TCL_OK;
1255     } else {
1256 	for (i = 2; i < objc-1; i += 2) {
1257 	    if (TableGetIndexObj(tablePtr, objv[i], &row, &col) == TCL_ERROR ||
1258 		(TableParseArrayIndex(&rs, &cs,
1259 				      Tcl_GetString(objv[i+1])) != 2) ||
1260 		Table_SpanSet(tablePtr, row, col, rs, cs) == TCL_ERROR) {
1261 		return TCL_ERROR;
1262 	    }
1263 	}
1264     }
1265     return TCL_OK;
1266 }
1267 
1268 /*
1269  *--------------------------------------------------------------
1270  *
1271  * Table_HiddenCmd --
1272  *	This procedure is invoked to process the hidden method
1273  *	that corresponds to a widget managed by this module.
1274  *	See the user documentation for details on what it does.
1275  *
1276  * Results:
1277  *	A standard Tcl result.
1278  *
1279  * Side effects:
1280  *	See the user documentation.
1281  *
1282  *--------------------------------------------------------------
1283  */
1284 int
Table_HiddenCmd(ClientData clientData,register Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1285 Table_HiddenCmd(ClientData clientData, register Tcl_Interp *interp,
1286 		int objc, Tcl_Obj *CONST objv[])
1287 {
1288     register Table *tablePtr = (Table *) clientData;
1289     int i, row, col;
1290     Tcl_HashEntry *entryPtr;
1291     char *span;
1292 
1293     if (objc < 2) {
1294 	Tcl_WrongNumArgs(interp, 2, objv, "?index? ?index ...?");
1295 	return TCL_ERROR;
1296     }
1297     if (tablePtr->spanTbl == NULL) {
1298 	/* Avoid the whole thing if we have no spans */
1299 	if (objc > 3) {
1300 	    Tcl_SetBooleanObj(Tcl_GetObjResult(interp), 0);
1301 	}
1302 	return TCL_OK;
1303     }
1304     if (objc == 2) {
1305 	/* return all "hidden" cells */
1306 	Tcl_DString cells;
1307 	Tcl_HashSearch search;
1308 
1309 
1310 	Tcl_DStringInit(&cells);
1311 	for (entryPtr = Tcl_FirstHashEntry(tablePtr->spanAffTbl, &search);
1312 	     entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&search)) {
1313 	    if ((span = (char *) Tcl_GetHashValue(entryPtr)) == NULL) {
1314 		/* this is actually a spanning cell */
1315 		continue;
1316 	    }
1317 	    Tcl_DStringAppendElement(&cells,
1318 				     Tcl_GetHashKey(tablePtr->spanAffTbl,
1319 						    entryPtr));
1320 	}
1321 	span = Tcl_GetString(TableCellSort(tablePtr, Tcl_DStringValue(&cells)));
1322 	if (span != NULL) {
1323 	    Tcl_SetResult(interp, span, TCL_DYNAMIC);
1324 	}
1325 	Tcl_DStringFree(&cells);
1326 	return TCL_OK;
1327     }
1328     if (objc == 3) {
1329 	if (TableGetIndexObj(tablePtr, objv[2], &row, &col) != TCL_OK) {
1330 	    return TCL_ERROR;
1331 	}
1332 	/* Just return the spanning values of the one cell */
1333 	entryPtr = Tcl_FindHashEntry(tablePtr->spanAffTbl,
1334 				     Tcl_GetString(objv[2]));
1335 	if (entryPtr != NULL &&
1336 	    (span = (char *)Tcl_GetHashValue(entryPtr)) != NULL) {
1337 	    /* this is a hidden cell */
1338 	    Tcl_SetStringObj(Tcl_GetObjResult(interp), span, -1);
1339 	}
1340 	return TCL_OK;
1341     }
1342     for (i = 2; i < objc; i++) {
1343 	if (TableGetIndexObj(tablePtr, objv[i], &row, &col) == TCL_ERROR) {
1344 	    return TCL_ERROR;
1345 	}
1346 	entryPtr = Tcl_FindHashEntry(tablePtr->spanAffTbl,
1347 				     Tcl_GetString(objv[i]));
1348 	if (entryPtr != NULL &&
1349 	    (char *)Tcl_GetHashValue(entryPtr) != NULL) {
1350 	    /* this is a hidden cell */
1351 	    continue;
1352 	}
1353 	/* We only reach here if it doesn't satisfy "hidden" criteria */
1354 	Tcl_SetBooleanObj(Tcl_GetObjResult(interp), 0);
1355 	return TCL_OK;
1356     }
1357     Tcl_SetBooleanObj(Tcl_GetObjResult(interp), 1);
1358     return TCL_OK;
1359 }
1360 
1361 /*
1362  *--------------------------------------------------------------
1363  *
1364  * TableSpanSanCheck --
1365  *	This procedure is invoked by TableConfigure to make sure
1366  *	that spans are kept sane according to the docs.
1367  *	See the user documentation for details on what it does.
1368  *
1369  * Results:
1370  *	void.
1371  *
1372  * Side effects:
1373  *	Spans in title areas can be reconstrained.
1374  *
1375  *--------------------------------------------------------------
1376  */
1377 void
TableSpanSanCheck(register Table * tablePtr)1378 TableSpanSanCheck(register Table *tablePtr)
1379 {
1380     int rs, cs, row, col, reset;
1381     Tcl_HashEntry *entryPtr;
1382     Tcl_HashSearch search;
1383 
1384     if (tablePtr->spanTbl == NULL) {
1385 	return;
1386     }
1387 
1388     for (entryPtr = Tcl_FirstHashEntry(tablePtr->spanTbl, &search);
1389 	 entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&search)) {
1390 	reset = 0;
1391 	TableParseArrayIndex(&row, &col,
1392 			     Tcl_GetHashKey(tablePtr->spanTbl, entryPtr));
1393 	TableParseArrayIndex(&rs, &cs,
1394 			     (char *) Tcl_GetHashValue(entryPtr));
1395 	if ((row-tablePtr->rowOffset < tablePtr->titleRows) &&
1396 	    (row-tablePtr->rowOffset+rs >= tablePtr->titleRows)) {
1397 	    rs = tablePtr->titleRows-(row-tablePtr->rowOffset)-1;
1398 	    reset = 1;
1399 	}
1400 	if ((col-tablePtr->colOffset < tablePtr->titleCols) &&
1401 	    (col-tablePtr->colOffset+cs >= tablePtr->titleCols)) {
1402 	    cs = tablePtr->titleCols-(col-tablePtr->colOffset)-1;
1403 	    reset = 1;
1404 	}
1405 	if (reset) {
1406 	    Table_SpanSet(tablePtr, row, col, rs, cs);
1407 	}
1408     }
1409 }
1410