1/* 2 * tkUtil.c -- 3 * 4 * This file contains miscellaneous utility functions that are used by 5 * the rest of Tk, such as a function for drawing a focus highlight. 6 * 7 * Copyright (c) 1994 The Regents of the University of California. 8 * Copyright (c) 1994-1997 Sun Microsystems, Inc. 9 * 10 * See the file "license.terms" for information on usage and redistribution of 11 * this file, and for a DISCLAIMER OF ALL WARRANTIES. 12 * 13 * RCS: @(#) $Id$ 14 */ 15 16#include "tkInt.h" 17 18/* 19 * The structure below defines the implementation of the "statekey" Tcl 20 * object, used for quickly finding a mapping in a TkStateMap. 21 */ 22 23Tcl_ObjType tkStateKeyObjType = { 24 "statekey", /* name */ 25 NULL, /* freeIntRepProc */ 26 NULL, /* dupIntRepProc */ 27 NULL, /* updateStringProc */ 28 NULL /* setFromAnyProc */ 29}; 30 31/* 32 *-------------------------------------------------------------- 33 * 34 * TkStateParseProc -- 35 * 36 * This function is invoked during option processing to handle the 37 * "-state" and "-default" options. 38 * 39 * Results: 40 * A standard Tcl return value. 41 * 42 * Side effects: 43 * The state for a given item gets replaced by the state indicated in the 44 * value argument. 45 * 46 *-------------------------------------------------------------- 47 */ 48 49int 50TkStateParseProc( 51 ClientData clientData, /* some flags.*/ 52 Tcl_Interp *interp, /* Used for reporting errors. */ 53 Tk_Window tkwin, /* Window containing canvas widget. */ 54 const char *value, /* Value of option. */ 55 char *widgRec, /* Pointer to record for item. */ 56 int offset) /* Offset into item. */ 57{ 58 int c; 59 int flags = PTR2INT(clientData); 60 size_t length; 61 62 register Tk_State *statePtr = (Tk_State *) (widgRec + offset); 63 64 if(value == NULL || *value == 0) { 65 *statePtr = TK_STATE_NULL; 66 return TCL_OK; 67 } 68 69 c = value[0]; 70 length = strlen(value); 71 72 if ((c == 'n') && (strncmp(value, "normal", length) == 0)) { 73 *statePtr = TK_STATE_NORMAL; 74 return TCL_OK; 75 } 76 if ((c == 'd') && (strncmp(value, "disabled", length) == 0)) { 77 *statePtr = TK_STATE_DISABLED; 78 return TCL_OK; 79 } 80 if ((c == 'a') && (flags&1) && (strncmp(value, "active", length) == 0)) { 81 *statePtr = TK_STATE_ACTIVE; 82 return TCL_OK; 83 } 84 if ((c == 'h') && (flags&2) && (strncmp(value, "hidden", length) == 0)) { 85 *statePtr = TK_STATE_HIDDEN; 86 return TCL_OK; 87 } 88 89 Tcl_AppendResult(interp, "bad ", (flags&4)?"-default" : "state", 90 " value \"", value, "\": must be normal", NULL); 91 if (flags&1) { 92 Tcl_AppendResult(interp, ", active", NULL); 93 } 94 if (flags&2) { 95 Tcl_AppendResult(interp, ", hidden", NULL); 96 } 97 if (flags&3) { 98 Tcl_AppendResult(interp, ",", NULL); 99 } 100 Tcl_AppendResult(interp, " or disabled", NULL); 101 *statePtr = TK_STATE_NORMAL; 102 return TCL_ERROR; 103} 104 105/* 106 *-------------------------------------------------------------- 107 * 108 * TkStatePrintProc -- 109 * 110 * This function is invoked by the Tk configuration code to produce a 111 * printable string for the "-state" configuration option. 112 * 113 * Results: 114 * The return value is a string describing the state for the item 115 * referred to by "widgRec". In addition, *freeProcPtr is filled in with 116 * the address of a function to call to free the result string when it's 117 * no longer needed (or NULL to indicate that the string doesn't need to 118 * be freed). 119 * 120 * Side effects: 121 * None. 122 * 123 *-------------------------------------------------------------- 124 */ 125 126char * 127TkStatePrintProc( 128 ClientData clientData, /* Ignored. */ 129 Tk_Window tkwin, /* Window containing canvas widget. */ 130 char *widgRec, /* Pointer to record for item. */ 131 int offset, /* Offset into item. */ 132 Tcl_FreeProc **freeProcPtr) /* Pointer to variable to fill in with 133 * information about how to reclaim storage 134 * for return string. */ 135{ 136 register Tk_State *statePtr = (Tk_State *) (widgRec + offset); 137 138 switch (*statePtr) { 139 case TK_STATE_NORMAL: 140 return "normal"; 141 case TK_STATE_DISABLED: 142 return "disabled"; 143 case TK_STATE_HIDDEN: 144 return "hidden"; 145 case TK_STATE_ACTIVE: 146 return "active"; 147 default: 148 return ""; 149 } 150} 151 152/* 153 *-------------------------------------------------------------- 154 * 155 * TkOrientParseProc -- 156 * 157 * This function is invoked during option processing to handle the 158 * "-orient" option. 159 * 160 * Results: 161 * A standard Tcl return value. 162 * 163 * Side effects: 164 * The orientation for a given item gets replaced by the orientation 165 * indicated in the value argument. 166 * 167 *-------------------------------------------------------------- 168 */ 169 170int 171TkOrientParseProc( 172 ClientData clientData, /* some flags.*/ 173 Tcl_Interp *interp, /* Used for reporting errors. */ 174 Tk_Window tkwin, /* Window containing canvas widget. */ 175 const char *value, /* Value of option. */ 176 char *widgRec, /* Pointer to record for item. */ 177 int offset) /* Offset into item. */ 178{ 179 int c; 180 size_t length; 181 182 register int *orientPtr = (int *) (widgRec + offset); 183 184 if(value == NULL || *value == 0) { 185 *orientPtr = 0; 186 return TCL_OK; 187 } 188 189 c = value[0]; 190 length = strlen(value); 191 192 if ((c == 'h') && (strncmp(value, "horizontal", length) == 0)) { 193 *orientPtr = 0; 194 return TCL_OK; 195 } 196 if ((c == 'v') && (strncmp(value, "vertical", length) == 0)) { 197 *orientPtr = 1; 198 return TCL_OK; 199 } 200 Tcl_AppendResult(interp, "bad orientation \"", value, 201 "\": must be vertical or horizontal", NULL); 202 *orientPtr = 0; 203 return TCL_ERROR; 204} 205 206/* 207 *-------------------------------------------------------------- 208 * 209 * TkOrientPrintProc -- 210 * 211 * This function is invoked by the Tk configuration code to produce a 212 * printable string for the "-orient" configuration option. 213 * 214 * Results: 215 * The return value is a string describing the orientation for the item 216 * referred to by "widgRec". In addition, *freeProcPtr is filled in with 217 * the address of a function to call to free the result string when it's 218 * no longer needed (or NULL to indicate that the string doesn't need to 219 * be freed). 220 * 221 * Side effects: 222 * None. 223 * 224 *-------------------------------------------------------------- 225 */ 226 227char * 228TkOrientPrintProc( 229 ClientData clientData, /* Ignored. */ 230 Tk_Window tkwin, /* Window containing canvas widget. */ 231 char *widgRec, /* Pointer to record for item. */ 232 int offset, /* Offset into item. */ 233 Tcl_FreeProc **freeProcPtr) /* Pointer to variable to fill in with 234 * information about how to reclaim storage 235 * for return string. */ 236{ 237 register int *statePtr = (int *) (widgRec + offset); 238 239 if (*statePtr) { 240 return "vertical"; 241 } else { 242 return "horizontal"; 243 } 244} 245 246/* 247 *---------------------------------------------------------------------- 248 * 249 * TkOffsetParseProc -- 250 * 251 * Converts the offset of a stipple or tile into the Tk_TSOffset 252 * structure. 253 * 254 *---------------------------------------------------------------------- 255 */ 256 257int 258TkOffsetParseProc( 259 ClientData clientData, /* not used */ 260 Tcl_Interp *interp, /* Interpreter to send results back to */ 261 Tk_Window tkwin, /* Window on same display as tile */ 262 const char *value, /* Name of image */ 263 char *widgRec, /* Widget structure record */ 264 int offset) /* Offset of tile in record */ 265{ 266 Tk_TSOffset *offsetPtr = (Tk_TSOffset *) (widgRec + offset); 267 Tk_TSOffset tsoffset; 268 const char *q, *p; 269 int result; 270 271 if ((value == NULL) || (*value == 0)) { 272 tsoffset.flags = TK_OFFSET_CENTER|TK_OFFSET_MIDDLE; 273 goto goodTSOffset; 274 } 275 tsoffset.flags = 0; 276 p = value; 277 278 switch(value[0]) { 279 case '#': 280 if (PTR2INT(clientData) & TK_OFFSET_RELATIVE) { 281 tsoffset.flags = TK_OFFSET_RELATIVE; 282 p++; 283 break; 284 } 285 goto badTSOffset; 286 case 'e': 287 switch(value[1]) { 288 case '\0': 289 tsoffset.flags = TK_OFFSET_RIGHT|TK_OFFSET_MIDDLE; 290 goto goodTSOffset; 291 case 'n': 292 if (value[2]!='d' || value[3]!='\0') { 293 goto badTSOffset; 294 } 295 tsoffset.flags = INT_MAX; 296 goto goodTSOffset; 297 } 298 case 'w': 299 if (value[1] != '\0') {goto badTSOffset;} 300 tsoffset.flags = TK_OFFSET_LEFT|TK_OFFSET_MIDDLE; 301 goto goodTSOffset; 302 case 'n': 303 if ((value[1] != '\0') && (value[2] != '\0')) { 304 goto badTSOffset; 305 } 306 switch(value[1]) { 307 case '\0': 308 tsoffset.flags = TK_OFFSET_CENTER|TK_OFFSET_TOP; 309 goto goodTSOffset; 310 case 'w': 311 tsoffset.flags = TK_OFFSET_LEFT|TK_OFFSET_TOP; 312 goto goodTSOffset; 313 case 'e': 314 tsoffset.flags = TK_OFFSET_RIGHT|TK_OFFSET_TOP; 315 goto goodTSOffset; 316 } 317 goto badTSOffset; 318 case 's': 319 if ((value[1] != '\0') && (value[2] != '\0')) { 320 goto badTSOffset; 321 } 322 switch(value[1]) { 323 case '\0': 324 tsoffset.flags = TK_OFFSET_CENTER|TK_OFFSET_BOTTOM; 325 goto goodTSOffset; 326 case 'w': 327 tsoffset.flags = TK_OFFSET_LEFT|TK_OFFSET_BOTTOM; 328 goto goodTSOffset; 329 case 'e': 330 tsoffset.flags = TK_OFFSET_RIGHT|TK_OFFSET_BOTTOM; 331 goto goodTSOffset; 332 } 333 goto badTSOffset; 334 case 'c': 335 if (strncmp(value, "center", strlen(value)) != 0) { 336 goto badTSOffset; 337 } 338 tsoffset.flags = TK_OFFSET_CENTER|TK_OFFSET_MIDDLE; 339 goto goodTSOffset; 340 } 341 if ((q = strchr(p,',')) == NULL) { 342 if (PTR2INT(clientData) & TK_OFFSET_INDEX) { 343 if (Tcl_GetInt(interp, (char *) p, &tsoffset.flags) != TCL_OK) { 344 Tcl_ResetResult(interp); 345 goto badTSOffset; 346 } 347 tsoffset.flags |= TK_OFFSET_INDEX; 348 goto goodTSOffset; 349 } 350 goto badTSOffset; 351 } 352 *((char *) q) = 0; 353 result = Tk_GetPixels(interp, tkwin, (char *) p, &tsoffset.xoffset); 354 *((char *) q) = ','; 355 if (result != TCL_OK) { 356 return TCL_ERROR; 357 } 358 if (Tk_GetPixels(interp, tkwin, (char*)q+1, &tsoffset.yoffset) != TCL_OK) { 359 return TCL_ERROR; 360 } 361 362 goodTSOffset: 363 /* 364 * Below is a hack to allow the stipple/tile offset to be stored in the 365 * internal tile structure. Most of the times, offsetPtr is a pointer to 366 * an already existing tile structure. However if this structure is not 367 * already created, we must do it with Tk_GetTile()!!!!; 368 */ 369 370 memcpy(offsetPtr, &tsoffset, sizeof(Tk_TSOffset)); 371 return TCL_OK; 372 373 badTSOffset: 374 Tcl_AppendResult(interp, "bad offset \"", value, 375 "\": expected \"x,y\"", NULL); 376 if (PTR2INT(clientData) & TK_OFFSET_RELATIVE) { 377 Tcl_AppendResult(interp, ", \"#x,y\"", NULL); 378 } 379 if (PTR2INT(clientData) & TK_OFFSET_INDEX) { 380 Tcl_AppendResult(interp, ", <index>", NULL); 381 } 382 Tcl_AppendResult(interp, ", n, ne, e, se, s, sw, w, nw, or center", NULL); 383 return TCL_ERROR; 384} 385 386/* 387 *---------------------------------------------------------------------- 388 * 389 * TkOffsetPrintProc -- 390 * 391 * Returns the offset of the tile. 392 * 393 * Results: 394 * The offset of the tile is returned. 395 * 396 *---------------------------------------------------------------------- 397 */ 398 399char * 400TkOffsetPrintProc( 401 ClientData clientData, /* not used */ 402 Tk_Window tkwin, /* not used */ 403 char *widgRec, /* Widget structure record */ 404 int offset, /* Offset of tile in record */ 405 Tcl_FreeProc **freeProcPtr) /* not used */ 406{ 407 Tk_TSOffset *offsetPtr = (Tk_TSOffset *) (widgRec + offset); 408 char *p, *q; 409 410 if (offsetPtr->flags & TK_OFFSET_INDEX) { 411 if (offsetPtr->flags >= INT_MAX) { 412 return "end"; 413 } 414 p = (char *) ckalloc(32); 415 sprintf(p, "%d", offsetPtr->flags & ~TK_OFFSET_INDEX); 416 *freeProcPtr = TCL_DYNAMIC; 417 return p; 418 } 419 if (offsetPtr->flags & TK_OFFSET_TOP) { 420 if (offsetPtr->flags & TK_OFFSET_LEFT) { 421 return "nw"; 422 } else if (offsetPtr->flags & TK_OFFSET_CENTER) { 423 return "n"; 424 } else if (offsetPtr->flags & TK_OFFSET_RIGHT) { 425 return "ne"; 426 } 427 } else if (offsetPtr->flags & TK_OFFSET_MIDDLE) { 428 if (offsetPtr->flags & TK_OFFSET_LEFT) { 429 return "w"; 430 } else if (offsetPtr->flags & TK_OFFSET_CENTER) { 431 return "center"; 432 } else if (offsetPtr->flags & TK_OFFSET_RIGHT) { 433 return "e"; 434 } 435 } else if (offsetPtr->flags & TK_OFFSET_BOTTOM) { 436 if (offsetPtr->flags & TK_OFFSET_LEFT) { 437 return "sw"; 438 } else if (offsetPtr->flags & TK_OFFSET_CENTER) { 439 return "s"; 440 } else if (offsetPtr->flags & TK_OFFSET_RIGHT) { 441 return "se"; 442 } 443 } 444 q = p = (char *) ckalloc(32); 445 if (offsetPtr->flags & TK_OFFSET_RELATIVE) { 446 *q++ = '#'; 447 } 448 sprintf(q, "%d,%d", offsetPtr->xoffset, offsetPtr->yoffset); 449 *freeProcPtr = TCL_DYNAMIC; 450 return p; 451} 452 453/* 454 *---------------------------------------------------------------------- 455 * 456 * TkPixelParseProc -- 457 * 458 * Converts the name of an image into a tile. 459 * 460 *---------------------------------------------------------------------- 461 */ 462 463int 464TkPixelParseProc( 465 ClientData clientData, /* If non-NULL, negative values are allowed as 466 * well */ 467 Tcl_Interp *interp, /* Interpreter to send results back to */ 468 Tk_Window tkwin, /* Window on same display as tile */ 469 const char *value, /* Name of image */ 470 char *widgRec, /* Widget structure record */ 471 int offset) /* Offset of tile in record */ 472{ 473 double *doublePtr = (double *) (widgRec + offset); 474 int result; 475 476 result = TkGetDoublePixels(interp, tkwin, value, doublePtr); 477 478 if ((result == TCL_OK) && (clientData == NULL) && (*doublePtr < 0.0)) { 479 Tcl_AppendResult(interp, "bad screen distance \"", value, "\"", NULL); 480 return TCL_ERROR; 481 } 482 return result; 483} 484 485/* 486 *---------------------------------------------------------------------- 487 * 488 * TkPixelPrintProc -- 489 * 490 * Returns the name of the tile. 491 * 492 * Results: 493 * The name of the tile is returned. 494 * 495 *---------------------------------------------------------------------- 496 */ 497 498char * 499TkPixelPrintProc( 500 ClientData clientData, /* not used */ 501 Tk_Window tkwin, /* not used */ 502 char *widgRec, /* Widget structure record */ 503 int offset, /* Offset of tile in record */ 504 Tcl_FreeProc **freeProcPtr) /* not used */ 505{ 506 double *doublePtr = (double *) (widgRec + offset); 507 char *p = (char *) ckalloc(24); 508 509 Tcl_PrintDouble(NULL, *doublePtr, p); 510 *freeProcPtr = TCL_DYNAMIC; 511 return p; 512} 513 514/* 515 *---------------------------------------------------------------------- 516 * 517 * TkDrawInsetFocusHighlight -- 518 * 519 * This function draws a rectangular ring around the outside of a widget 520 * to indicate that it has received the input focus. It takes an 521 * additional padding argument that specifies how much padding is present 522 * outside the widget. 523 * 524 * Results: 525 * None. 526 * 527 * Side effects: 528 * A rectangle "width" pixels wide is drawn in "drawable", corresponding 529 * to the outer area of "tkwin". 530 * 531 *---------------------------------------------------------------------- 532 */ 533 534void 535TkDrawInsetFocusHighlight( 536 Tk_Window tkwin, /* Window whose focus highlight ring is to be 537 * drawn. */ 538 GC gc, /* Graphics context to use for drawing the 539 * highlight ring. */ 540 int width, /* Width of the highlight ring, in pixels. */ 541 Drawable drawable, /* Where to draw the ring (typically a pixmap 542 * for double buffering). */ 543 int padding) /* Width of padding outside of widget. */ 544{ 545 XRectangle rects[4]; 546 547 rects[0].x = padding; 548 rects[0].y = padding; 549 rects[0].width = Tk_Width(tkwin) - (2 * padding); 550 rects[0].height = width; 551 rects[1].x = padding; 552 rects[1].y = Tk_Height(tkwin) - width - padding; 553 rects[1].width = Tk_Width(tkwin) - (2 * padding); 554 rects[1].height = width; 555 rects[2].x = padding; 556 rects[2].y = width + padding; 557 rects[2].width = width; 558 rects[2].height = Tk_Height(tkwin) - 2*width - 2*padding; 559 rects[3].x = Tk_Width(tkwin) - width - padding; 560 rects[3].y = rects[2].y; 561 rects[3].width = width; 562 rects[3].height = rects[2].height; 563 XFillRectangles(Tk_Display(tkwin), drawable, gc, rects, 4); 564} 565 566/* 567 *---------------------------------------------------------------------- 568 * 569 * Tk_DrawFocusHighlight -- 570 * 571 * This function draws a rectangular ring around the outside of a widget 572 * to indicate that it has received the input focus. 573 * 574 * This function is now deprecated. Use TkpDrawHighlightBorder instead, 575 * since this function does not handle drawing the Focus ring properly on 576 * the Macintosh - you need to know the background GC as well as the 577 * foreground since the Mac focus ring separated from the widget by a 1 578 * pixel border. 579 * 580 * Results: 581 * None. 582 * 583 * Side effects: 584 * A rectangle "width" pixels wide is drawn in "drawable", corresponding 585 * to the outer area of "tkwin". 586 * 587 *---------------------------------------------------------------------- 588 */ 589 590void 591Tk_DrawFocusHighlight( 592 Tk_Window tkwin, /* Window whose focus highlight ring is to be 593 * drawn. */ 594 GC gc, /* Graphics context to use for drawing the 595 * highlight ring. */ 596 int width, /* Width of the highlight ring, in pixels. */ 597 Drawable drawable) /* Where to draw the ring (typically a pixmap 598 * for double buffering). */ 599{ 600 TkDrawInsetFocusHighlight(tkwin, gc, width, drawable, 0); 601} 602 603/* 604 *---------------------------------------------------------------------- 605 * 606 * Tk_GetScrollInfo -- 607 * 608 * This function is invoked to parse "xview" and "yview" scrolling 609 * commands for widgets using the new scrolling command syntax ("moveto" 610 * or "scroll" options). 611 * 612 * Results: 613 * The return value is either TK_SCROLL_MOVETO, TK_SCROLL_PAGES, 614 * TK_SCROLL_UNITS, or TK_SCROLL_ERROR. This indicates whether the 615 * command was successfully parsed and what form the command took. If 616 * TK_SCROLL_MOVETO, *dblPtr is filled in with the desired position; if 617 * TK_SCROLL_PAGES or TK_SCROLL_UNITS, *intPtr is filled in with the 618 * number of lines to move (may be negative); if TK_SCROLL_ERROR, the 619 * interp's result contains an error message. 620 * 621 * Side effects: 622 * None. 623 * 624 *---------------------------------------------------------------------- 625 */ 626 627int 628Tk_GetScrollInfo( 629 Tcl_Interp *interp, /* Used for error reporting. */ 630 int argc, /* # arguments for command. */ 631 const char **argv, /* Arguments for command. */ 632 double *dblPtr, /* Filled in with argument "moveto" option, if 633 * any. */ 634 int *intPtr) /* Filled in with number of pages or lines to 635 * scroll, if any. */ 636{ 637 int c = argv[2][0]; 638 size_t length = strlen(argv[2]); 639 640 if ((c == 'm') && (strncmp(argv[2], "moveto", length) == 0)) { 641 if (argc != 4) { 642 Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], 643 " ", argv[1], " moveto fraction\"", NULL); 644 return TK_SCROLL_ERROR; 645 } 646 if (Tcl_GetDouble(interp, argv[3], dblPtr) != TCL_OK) { 647 return TK_SCROLL_ERROR; 648 } 649 return TK_SCROLL_MOVETO; 650 } else if ((c == 's') 651 && (strncmp(argv[2], "scroll", length) == 0)) { 652 if (argc != 5) { 653 Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], 654 " ", argv[1], " scroll number units|pages\"", NULL); 655 return TK_SCROLL_ERROR; 656 } 657 if (Tcl_GetInt(interp, argv[3], intPtr) != TCL_OK) { 658 return TK_SCROLL_ERROR; 659 } 660 length = strlen(argv[4]); 661 c = argv[4][0]; 662 if ((c == 'p') && (strncmp(argv[4], "pages", length) == 0)) { 663 return TK_SCROLL_PAGES; 664 } else if ((c == 'u') && (strncmp(argv[4], "units", length) == 0)) { 665 return TK_SCROLL_UNITS; 666 } 667 668 Tcl_AppendResult(interp, "bad argument \"", argv[4], 669 "\": must be units or pages", NULL); 670 return TK_SCROLL_ERROR; 671 } 672 Tcl_AppendResult(interp, "unknown option \"", argv[2], 673 "\": must be moveto or scroll", NULL); 674 return TK_SCROLL_ERROR; 675} 676 677/* 678 *---------------------------------------------------------------------- 679 * 680 * Tk_GetScrollInfoObj -- 681 * 682 * This function is invoked to parse "xview" and "yview" scrolling 683 * commands for widgets using the new scrolling command syntax ("moveto" 684 * or "scroll" options). 685 * 686 * Results: 687 * The return value is either TK_SCROLL_MOVETO, TK_SCROLL_PAGES, 688 * TK_SCROLL_UNITS, or TK_SCROLL_ERROR. This indicates whether the 689 * command was successfully parsed and what form the command took. If 690 * TK_SCROLL_MOVETO, *dblPtr is filled in with the desired position; if 691 * TK_SCROLL_PAGES or TK_SCROLL_UNITS, *intPtr is filled in with the 692 * number of lines to move (may be negative); if TK_SCROLL_ERROR, the 693 * interp's result contains an error message. 694 * 695 * Side effects: 696 * None. 697 * 698 *---------------------------------------------------------------------- 699 */ 700 701int 702Tk_GetScrollInfoObj( 703 Tcl_Interp *interp, /* Used for error reporting. */ 704 int objc, /* # arguments for command. */ 705 Tcl_Obj *const objv[], /* Arguments for command. */ 706 double *dblPtr, /* Filled in with argument "moveto" option, if 707 * any. */ 708 int *intPtr) /* Filled in with number of pages or lines to 709 * scroll, if any. */ 710{ 711 int length; 712 const char *arg; 713 714 arg = Tcl_GetStringFromObj(objv[2], &length); 715 716#define ArgPfxEq(str) ((arg[0]==str[0])&&!strncmp(arg,str,(unsigned)length)) 717 718 if (ArgPfxEq("moveto")) { 719 if (objc != 4) { 720 Tcl_WrongNumArgs(interp, 2, objv, "moveto fraction"); 721 return TK_SCROLL_ERROR; 722 } 723 if (Tcl_GetDoubleFromObj(interp, objv[3], dblPtr) != TCL_OK) { 724 return TK_SCROLL_ERROR; 725 } 726 return TK_SCROLL_MOVETO; 727 } else if (ArgPfxEq("scroll")) { 728 if (objc != 5) { 729 Tcl_WrongNumArgs(interp, 2, objv, "scroll number units|pages"); 730 return TK_SCROLL_ERROR; 731 } 732 if (Tcl_GetIntFromObj(interp, objv[3], intPtr) != TCL_OK) { 733 return TK_SCROLL_ERROR; 734 } 735 736 arg = Tcl_GetStringFromObj(objv[4], &length); 737 if (ArgPfxEq("pages")) { 738 return TK_SCROLL_PAGES; 739 } else if (ArgPfxEq("units")) { 740 return TK_SCROLL_UNITS; 741 } 742 743 Tcl_AppendResult(interp, "bad argument \"", arg, 744 "\": must be units or pages", NULL); 745 return TK_SCROLL_ERROR; 746 } 747 Tcl_AppendResult(interp, "unknown option \"", arg, 748 "\": must be moveto or scroll", NULL); 749 return TK_SCROLL_ERROR; 750} 751 752/* 753 *--------------------------------------------------------------------------- 754 * 755 * TkComputeAnchor -- 756 * 757 * Determine where to place a rectangle so that it will be properly 758 * anchored with respect to the given window. Used by widgets to align a 759 * box of text inside a window. When anchoring with respect to one of the 760 * sides, the rectangle be placed inside of the internal border of the 761 * window. 762 * 763 * Results: 764 * *xPtr and *yPtr set to the upper-left corner of the rectangle anchored 765 * in the window. 766 * 767 * Side effects: 768 * None. 769 * 770 *--------------------------------------------------------------------------- 771 */ 772 773void 774TkComputeAnchor( 775 Tk_Anchor anchor, /* Desired anchor. */ 776 Tk_Window tkwin, /* Anchored with respect to this window. */ 777 int padX, int padY, /* Use this extra padding inside window, in 778 * addition to the internal border. */ 779 int innerWidth, int innerHeight, 780 /* Size of rectangle to anchor in window. */ 781 int *xPtr, int *yPtr) /* Returns upper-left corner of anchored 782 * rectangle. */ 783{ 784 /* 785 * Handle the horizontal parts. 786 */ 787 788 switch (anchor) { 789 case TK_ANCHOR_NW: 790 case TK_ANCHOR_W: 791 case TK_ANCHOR_SW: 792 *xPtr = Tk_InternalBorderLeft(tkwin) + padX; 793 break; 794 795 case TK_ANCHOR_N: 796 case TK_ANCHOR_CENTER: 797 case TK_ANCHOR_S: 798 *xPtr = (Tk_Width(tkwin) - innerWidth - Tk_InternalBorderLeft(tkwin) - 799 Tk_InternalBorderRight(tkwin)) / 2 + 800 Tk_InternalBorderLeft(tkwin); 801 break; 802 803 default: 804 *xPtr = Tk_Width(tkwin) - Tk_InternalBorderRight(tkwin) - padX 805 - innerWidth; 806 break; 807 } 808 809 /* 810 * Handle the vertical parts. 811 */ 812 813 switch (anchor) { 814 case TK_ANCHOR_NW: 815 case TK_ANCHOR_N: 816 case TK_ANCHOR_NE: 817 *yPtr = Tk_InternalBorderTop(tkwin) + padY; 818 break; 819 820 case TK_ANCHOR_W: 821 case TK_ANCHOR_CENTER: 822 case TK_ANCHOR_E: 823 *yPtr = (Tk_Height(tkwin) - innerHeight- Tk_InternalBorderTop(tkwin) - 824 Tk_InternalBorderBottom(tkwin)) / 2 + 825 Tk_InternalBorderTop(tkwin); 826 break; 827 828 default: 829 *yPtr = Tk_Height(tkwin) - Tk_InternalBorderBottom(tkwin) - padY 830 - innerHeight; 831 break; 832 } 833} 834 835/* 836 *--------------------------------------------------------------------------- 837 * 838 * TkFindStateString -- 839 * 840 * Given a lookup table, map a number to a string in the table. 841 * 842 * Results: 843 * If numKey was equal to the numeric key of one of the elements in the 844 * table, returns the string key of that element. Returns NULL if numKey 845 * was not equal to any of the numeric keys in the table. 846 * 847 * Side effects. 848 * None. 849 * 850 *--------------------------------------------------------------------------- 851 */ 852 853char * 854TkFindStateString( 855 const TkStateMap *mapPtr, /* The state table. */ 856 int numKey) /* The key to try to find in the table. */ 857{ 858 for (; mapPtr->strKey!=NULL ; mapPtr++) { 859 if (numKey == mapPtr->numKey) { 860 return (char *) mapPtr->strKey; 861 } 862 } 863 return NULL; 864} 865 866/* 867 *--------------------------------------------------------------------------- 868 * 869 * TkFindStateNum, TkFindStateNumObj -- 870 * 871 * Given a lookup table, map a string to a number in the table. 872 * 873 * Results: 874 * If strKey was equal to the string keys of one of the elements in the 875 * table, returns the numeric key of that element. Returns the numKey 876 * associated with the last element (the NULL string one) in the table if 877 * strKey was not equal to any of the string keys in the table. In that 878 * case, an error message is also left in the interp's result (if interp 879 * is not NULL). 880 * 881 * Side effects. 882 * None. 883 * 884 *--------------------------------------------------------------------------- 885 */ 886 887int 888TkFindStateNum( 889 Tcl_Interp *interp, /* Interp for error reporting. */ 890 const char *option, /* String to use when constructing error. */ 891 const TkStateMap *mapPtr, /* Lookup table. */ 892 const char *strKey) /* String to try to find in lookup table. */ 893{ 894 const TkStateMap *mPtr; 895 896 /* 897 * See if the value is in the state map. 898 */ 899 900 for (mPtr = mapPtr; mPtr->strKey != NULL; mPtr++) { 901 if (strcmp(strKey, mPtr->strKey) == 0) { 902 return mPtr->numKey; 903 } 904 } 905 906 /* 907 * Not there. Generate an error message (if we can) and return the 908 * default. 909 */ 910 911 if (interp != NULL) { 912 mPtr = mapPtr; 913 Tcl_AppendResult(interp, "bad ", option, " value \"", strKey, 914 "\": must be ", mPtr->strKey, NULL); 915 for (mPtr++; mPtr->strKey != NULL; mPtr++) { 916 Tcl_AppendResult(interp, 917 ((mPtr[1].strKey != NULL) ? ", " : ", or "), 918 mPtr->strKey, NULL); 919 } 920 } 921 return mPtr->numKey; 922} 923 924int 925TkFindStateNumObj( 926 Tcl_Interp *interp, /* Interp for error reporting. */ 927 Tcl_Obj *optionPtr, /* String to use when constructing error. */ 928 const TkStateMap *mapPtr, /* Lookup table. */ 929 Tcl_Obj *keyPtr) /* String key to find in lookup table. */ 930{ 931 const TkStateMap *mPtr; 932 const char *key; 933 const Tcl_ObjType *typePtr; 934 935 /* 936 * See if the value is in the object cache. 937 */ 938 939 if ((keyPtr->typePtr == &tkStateKeyObjType) 940 && (keyPtr->internalRep.twoPtrValue.ptr1 == mapPtr)) { 941 return PTR2INT(keyPtr->internalRep.twoPtrValue.ptr2); 942 } 943 944 /* 945 * Not there. Look in the state map. 946 */ 947 948 key = Tcl_GetStringFromObj(keyPtr, NULL); 949 for (mPtr = mapPtr; mPtr->strKey != NULL; mPtr++) { 950 if (strcmp(key, mPtr->strKey) == 0) { 951 typePtr = keyPtr->typePtr; 952 if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) { 953 (*typePtr->freeIntRepProc)(keyPtr); 954 } 955 keyPtr->internalRep.twoPtrValue.ptr1 = (void *) mapPtr; 956 keyPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(mPtr->numKey); 957 keyPtr->typePtr = &tkStateKeyObjType; 958 return mPtr->numKey; 959 } 960 } 961 962 /* 963 * Not there either. Generate an error message (if we can) and return the 964 * default. 965 */ 966 967 if (interp != NULL) { 968 mPtr = mapPtr; 969 Tcl_AppendResult(interp, "bad ", Tcl_GetString(optionPtr), 970 " value \"", key, "\": must be ", mPtr->strKey, NULL); 971 for (mPtr++; mPtr->strKey != NULL; mPtr++) { 972 Tcl_AppendResult(interp, 973 ((mPtr[1].strKey != NULL) ? ", " : ", or "), 974 mPtr->strKey, NULL); 975 } 976 } 977 return mPtr->numKey; 978} 979 980/* 981 * ---------------------------------------------------------------------- 982 * 983 * TkBackgroundEvalObjv -- 984 * 985 * Evaluate a command while ensuring that we do not affect the 986 * interpreters state. This is important when evaluating script 987 * during background tasks. 988 * 989 * Results: 990 * A standard Tcl result code. 991 * 992 * Side Effects: 993 * The interpreters variables and code may be modified by the script 994 * but the result will not be modified. 995 * 996 * ---------------------------------------------------------------------- 997 */ 998 999int 1000TkBackgroundEvalObjv( 1001 Tcl_Interp *interp, 1002 int objc, 1003 Tcl_Obj *const *objv, 1004 int flags) 1005{ 1006 Tcl_DString errorInfo, errorCode; 1007 Tcl_SavedResult state; 1008 int n, r = TCL_OK; 1009 1010 Tcl_DStringInit(&errorInfo); 1011 Tcl_DStringInit(&errorCode); 1012 1013 Tcl_Preserve(interp); 1014 1015 /* 1016 * Record the state of the interpreter 1017 */ 1018 1019 Tcl_SaveResult(interp, &state); 1020 Tcl_DStringAppend(&errorInfo, 1021 Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY), -1); 1022 Tcl_DStringAppend(&errorCode, 1023 Tcl_GetVar(interp, "errorCode", TCL_GLOBAL_ONLY), -1); 1024 1025 /* 1026 * Evaluate the command and handle any error. 1027 */ 1028 1029 for (n = 0; n < objc; ++n) { 1030 Tcl_IncrRefCount(objv[n]); 1031 } 1032 r = Tcl_EvalObjv(interp, objc, objv, flags); 1033 for (n = 0; n < objc; ++n) { 1034 Tcl_DecrRefCount(objv[n]); 1035 } 1036 if (r == TCL_ERROR) { 1037 Tcl_AddErrorInfo(interp, "\n (background event handler)"); 1038 Tcl_BackgroundError(interp); 1039 } 1040 1041 Tcl_Release(interp); 1042 1043 /* 1044 * Restore the state of the interpreter 1045 */ 1046 1047 Tcl_SetVar(interp, "errorInfo", 1048 Tcl_DStringValue(&errorInfo), TCL_GLOBAL_ONLY); 1049 Tcl_SetVar(interp, "errorCode", 1050 Tcl_DStringValue(&errorCode), TCL_GLOBAL_ONLY); 1051 Tcl_RestoreResult(interp, &state); 1052 1053 /* 1054 * Clean up references. 1055 */ 1056 1057 Tcl_DStringFree(&errorInfo); 1058 Tcl_DStringFree(&errorCode); 1059 1060 return r; 1061} 1062 1063/* 1064 * Local Variables: 1065 * mode: c 1066 * c-basic-offset: 4 1067 * fill-column: 78 1068 * End: 1069 */ 1070