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