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