1/* 2 * tkObj.c -- 3 * 4 * This file contains functions that implement the common Tk object types 5 * 6 * Copyright (c) 1997 Sun Microsystems, Inc. 7 * 8 * See the file "license.terms" for information on usage and redistribution of 9 * this file, and for a DISCLAIMER OF ALL WARRANTIES. 10 * 11 * RCS: @(#) $Id$ 12 */ 13 14#include "tkInt.h" 15 16/* 17 * The following structure is the internal representation for pixel objects. 18 */ 19 20typedef struct PixelRep { 21 double value; 22 int units; 23 Tk_Window tkwin; 24 int returnValue; 25} PixelRep; 26 27#define SIMPLE_PIXELREP(objPtr) \ 28 ((objPtr)->internalRep.twoPtrValue.ptr2 == 0) 29 30#define SET_SIMPLEPIXEL(objPtr, intval) \ 31 (objPtr)->internalRep.twoPtrValue.ptr1 = INT2PTR(intval); \ 32 (objPtr)->internalRep.twoPtrValue.ptr2 = 0 33 34#define GET_SIMPLEPIXEL(objPtr) \ 35 (PTR2INT((objPtr)->internalRep.twoPtrValue.ptr1)) 36 37#define SET_COMPLEXPIXEL(objPtr, repPtr) \ 38 (objPtr)->internalRep.twoPtrValue.ptr1 = 0; \ 39 (objPtr)->internalRep.twoPtrValue.ptr2 = (VOID *) repPtr 40 41#define GET_COMPLEXPIXEL(objPtr) \ 42 ((PixelRep *) (objPtr)->internalRep.twoPtrValue.ptr2) 43 44 45/* 46 * The following structure is the internal representation for mm objects. 47 */ 48 49typedef struct MMRep { 50 double value; 51 int units; 52 Tk_Window tkwin; 53 double returnValue; 54} MMRep; 55 56/* 57 * The following structure is the internal representation for window objects. 58 * A WindowRep caches name-to-window lookups. The cache is invalid if tkwin is 59 * NULL or if mainPtr->deletionEpoch does not match epoch. 60 */ 61 62typedef struct WindowRep { 63 Tk_Window tkwin; /* Cached window; NULL if not found. */ 64 TkMainInfo *mainPtr; /* MainWindow associated with tkwin. */ 65 long epoch; /* Value of mainPtr->deletionEpoch at last 66 * successful lookup. */ 67} WindowRep; 68 69/* 70 * Prototypes for functions defined later in this file: 71 */ 72 73static void DupMMInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); 74static void DupPixelInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); 75static void DupWindowInternalRep(Tcl_Obj *srcPtr,Tcl_Obj *copyPtr); 76static void FreeMMInternalRep(Tcl_Obj *objPtr); 77static void FreePixelInternalRep(Tcl_Obj *objPtr); 78static void FreeWindowInternalRep(Tcl_Obj *objPtr); 79static void UpdateStringOfMM(Tcl_Obj *objPtr); 80static int SetMMFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); 81static int SetPixelFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); 82static int SetWindowFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); 83 84/* 85 * The following structure defines the implementation of the "pixel" Tcl 86 * object, used for measuring distances. The pixel object remembers its 87 * initial display-independant settings. 88 */ 89 90static Tcl_ObjType pixelObjType = { 91 "pixel", /* name */ 92 FreePixelInternalRep, /* freeIntRepProc */ 93 DupPixelInternalRep, /* dupIntRepProc */ 94 NULL, /* updateStringProc */ 95 SetPixelFromAny /* setFromAnyProc */ 96}; 97 98/* 99 * The following structure defines the implementation of the "pixel" Tcl 100 * object, used for measuring distances. The pixel object remembers its 101 * initial display-independant settings. 102 */ 103 104static Tcl_ObjType mmObjType = { 105 "mm", /* name */ 106 FreeMMInternalRep, /* freeIntRepProc */ 107 DupMMInternalRep, /* dupIntRepProc */ 108 UpdateStringOfMM, /* updateStringProc */ 109 SetMMFromAny /* setFromAnyProc */ 110}; 111 112/* 113 * The following structure defines the implementation of the "window" 114 * Tcl object. 115 */ 116 117static Tcl_ObjType windowObjType = { 118 "window", /* name */ 119 FreeWindowInternalRep, /* freeIntRepProc */ 120 DupWindowInternalRep, /* dupIntRepProc */ 121 NULL, /* updateStringProc */ 122 SetWindowFromAny /* setFromAnyProc */ 123}; 124 125/* 126 *---------------------------------------------------------------------- 127 * 128 * GetPixelsFromObjEx -- 129 * 130 * Attempt to return a pixel value from the Tcl object "objPtr". If the 131 * object is not already a pixel value, an attempt will be made to 132 * convert it to one. 133 * 134 * Results: 135 * The return value is a standard Tcl object result. If an error occurs 136 * during conversion, an error message is left in the interpreter's 137 * result unless "interp" is NULL. 138 * 139 * Side effects: 140 * If the object is not already a pixel, the conversion will free any old 141 * internal representation. 142 * 143 *---------------------------------------------------------------------- 144 */ 145 146static 147int 148GetPixelsFromObjEx( 149 Tcl_Interp *interp, /* Used for error reporting if not NULL. */ 150 Tk_Window tkwin, 151 Tcl_Obj *objPtr, /* The object from which to get pixels. */ 152 int *intPtr, 153 double *dblPtr) /* Places to store resulting pixels. */ 154{ 155 int result,fresh; 156 double d; 157 PixelRep *pixelPtr; 158 static double bias[] = { 159 1.0, 10.0, 25.4, 0.35278 /*25.4 / 72.0*/ 160 }; 161 162 retry: 163 if (objPtr->typePtr != &pixelObjType) { 164 result = SetPixelFromAny(interp, objPtr); 165 if (result != TCL_OK) { 166 return result; 167 } 168 fresh=1; 169 } else { 170 fresh=0; 171 } 172 173 if (SIMPLE_PIXELREP(objPtr)) { 174 *intPtr = GET_SIMPLEPIXEL(objPtr); 175 if (dblPtr) { 176 *dblPtr=(double)(*intPtr); 177 } 178 } else { 179 pixelPtr = GET_COMPLEXPIXEL(objPtr); 180 if ((!fresh) && (pixelPtr->tkwin != tkwin)) 181 { 182 /* in case of exo-screen conversions of non-pixels 183 * we force a recomputation from the string 184 */ 185 186 FreePixelInternalRep(objPtr); 187 goto retry; 188 } 189 if ((pixelPtr->tkwin != tkwin)||dblPtr) { 190 d = pixelPtr->value; 191 if (pixelPtr->units >= 0) { 192 d *= bias[pixelPtr->units] * WidthOfScreen(Tk_Screen(tkwin)); 193 d /= WidthMMOfScreen(Tk_Screen(tkwin)); 194 } 195 if (d < 0) { 196 pixelPtr->returnValue = (int) (d - 0.5); 197 } else { 198 pixelPtr->returnValue = (int) (d + 0.5); 199 } 200 pixelPtr->tkwin = tkwin; 201 if (dblPtr) { 202 *dblPtr=(double)d; 203 } 204 } 205 *intPtr = pixelPtr->returnValue; 206 } 207 return TCL_OK; 208} 209 210/* 211 *---------------------------------------------------------------------- 212 * 213 * Tk_GetPixelsFromObj -- 214 * 215 * Attempt to return a pixel value from the Tcl object "objPtr". If the 216 * object is not already a pixel value, an attempt will be made to 217 * convert it to one. 218 * 219 * Results: 220 * The return value is a standard Tcl object result. If an error occurs 221 * during conversion, an error message is left in the interpreter's 222 * result unless "interp" is NULL. 223 * 224 * Side effects: 225 * If the object is not already a pixel, the conversion will free any old 226 * internal representation. 227 * 228 *---------------------------------------------------------------------- 229 */ 230 231int 232Tk_GetPixelsFromObj( 233 Tcl_Interp *interp, /* Used for error reporting if not NULL. */ 234 Tk_Window tkwin, 235 Tcl_Obj *objPtr, /* The object from which to get pixels. */ 236 int *intPtr) /* Place to store resulting pixels. */ 237{ 238 return GetPixelsFromObjEx(interp,tkwin,objPtr,intPtr,NULL); 239} 240 241/* 242 *---------------------------------------------------------------------- 243 * 244 * Tk_GetDoublePixelsFromObj -- 245 * 246 * Attempt to return a double pixel value from the Tcl object 247 * "objPtr". If the object is not already a pixel value, an attempt will 248 * be made to convert it to one, the internal unit being pixels. 249 * 250 * Results: 251 * The return value is a standard Tcl object result. If an error occurs 252 * during conversion, an error message is left in the interpreter's 253 * result unless "interp" is NULL. 254 * 255 * Side effects: 256 * If the object is not already a pixel, the conversion will free any old 257 * internal representation. 258 * 259 *---------------------------------------------------------------------- 260 */ 261 262int 263Tk_GetDoublePixelsFromObj( 264 Tcl_Interp *interp, /* Used for error reporting if not NULL. */ 265 Tk_Window tkwin, 266 Tcl_Obj *objPtr, /* The object from which to get pixels. */ 267 double *doublePtr) /* Place to store resulting pixels. */ 268{ 269 double d; 270 int result,val; 271 272 result=GetPixelsFromObjEx(interp, tkwin, objPtr, &val, &d); 273 if (result != TCL_OK) { 274 return result; 275 } 276 if (!SIMPLE_PIXELREP(objPtr)) { 277 PixelRep *pixelPtr; 278 pixelPtr = GET_COMPLEXPIXEL(objPtr); 279 if (pixelPtr->units >= 0) { 280 /* internally "shimmer" to pixel units */ 281 pixelPtr->units=-1; 282 pixelPtr->value=d; 283 } 284 } 285 *doublePtr = d; 286 return TCL_OK; 287} 288 289/* 290 *---------------------------------------------------------------------- 291 * 292 * FreePixelInternalRep -- 293 * 294 * Deallocate the storage associated with a pixel object's internal 295 * representation. 296 * 297 * Results: 298 * None. 299 * 300 * Side effects: 301 * Frees objPtr's internal representation and sets objPtr's internalRep 302 * to NULL. 303 * 304 *---------------------------------------------------------------------- 305 */ 306 307static void 308FreePixelInternalRep( 309 Tcl_Obj *objPtr) /* Pixel object with internal rep to free. */ 310{ 311 PixelRep *pixelPtr; 312 313 if (!SIMPLE_PIXELREP(objPtr)) { 314 pixelPtr = GET_COMPLEXPIXEL(objPtr); 315 ckfree((char *) pixelPtr); 316 } 317 SET_SIMPLEPIXEL(objPtr, 0); 318 objPtr->typePtr = NULL; 319} 320 321/* 322 *---------------------------------------------------------------------- 323 * 324 * DupPixelInternalRep -- 325 * 326 * Initialize the internal representation of a pixel Tcl_Obj to a copy of 327 * the internal representation of an existing pixel object. 328 * 329 * Results: 330 * None. 331 * 332 * Side effects: 333 * copyPtr's internal rep is set to the pixel corresponding to srcPtr's 334 * internal rep. 335 * 336 *---------------------------------------------------------------------- 337 */ 338 339static void 340DupPixelInternalRep( 341 register Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ 342 register Tcl_Obj *copyPtr) /* Object with internal rep to set. */ 343{ 344 PixelRep *oldPtr, *newPtr; 345 346 copyPtr->typePtr = srcPtr->typePtr; 347 348 if (SIMPLE_PIXELREP(srcPtr)) { 349 SET_SIMPLEPIXEL(copyPtr, GET_SIMPLEPIXEL(srcPtr)); 350 } else { 351 oldPtr = GET_COMPLEXPIXEL(srcPtr); 352 newPtr = (PixelRep *) ckalloc(sizeof(PixelRep)); 353 newPtr->value = oldPtr->value; 354 newPtr->units = oldPtr->units; 355 newPtr->tkwin = oldPtr->tkwin; 356 newPtr->returnValue = oldPtr->returnValue; 357 SET_COMPLEXPIXEL(copyPtr, newPtr); 358 } 359} 360 361/* 362 *---------------------------------------------------------------------- 363 * 364 * SetPixelFromAny -- 365 * 366 * Attempt to generate a pixel internal form for the Tcl object "objPtr". 367 * 368 * Results: 369 * The return value is a standard Tcl result. If an error occurs during 370 * conversion, an error message is left in the interpreter's result 371 * unless "interp" is NULL. 372 * 373 * Side effects: 374 * If no error occurs, a pixel representation of the object is stored 375 * internally and the type of "objPtr" is set to pixel. 376 * 377 *---------------------------------------------------------------------- 378 */ 379 380static int 381SetPixelFromAny( 382 Tcl_Interp *interp, /* Used for error reporting if not NULL. */ 383 Tcl_Obj *objPtr) /* The object to convert. */ 384{ 385 const Tcl_ObjType *typePtr; 386 char *string, *rest; 387 double d; 388 int i, units; 389 390 string = Tcl_GetStringFromObj(objPtr, NULL); 391 392 d = strtod(string, &rest); 393 if (rest == string) { 394 goto error; 395 } 396 while ((*rest != '\0') && isspace(UCHAR(*rest))) { 397 rest++; 398 } 399 400 switch (*rest) { 401 case '\0': 402 units = -1; 403 break; 404 case 'm': 405 units = 0; 406 break; 407 case 'c': 408 units = 1; 409 break; 410 case 'i': 411 units = 2; 412 break; 413 case 'p': 414 units = 3; 415 break; 416 default: 417 goto error; 418 } 419 420 /* 421 * Free the old internalRep before setting the new one. 422 */ 423 424 typePtr = objPtr->typePtr; 425 if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) { 426 (*typePtr->freeIntRepProc)(objPtr); 427 } 428 429 objPtr->typePtr = &pixelObjType; 430 431 i = (int) d; 432 if ((units < 0) && (i == d)) { 433 SET_SIMPLEPIXEL(objPtr, i); 434 } else { 435 PixelRep *pixelPtr = (PixelRep *) ckalloc(sizeof(PixelRep)); 436 437 pixelPtr->value = d; 438 pixelPtr->units = units; 439 pixelPtr->tkwin = NULL; 440 pixelPtr->returnValue = i; 441 SET_COMPLEXPIXEL(objPtr, pixelPtr); 442 } 443 return TCL_OK; 444 445 error: 446 if (interp != NULL) { 447 /* 448 * Must copy string before resetting the result in case a caller is 449 * trying to convert the interpreter's result to pixels. 450 */ 451 452 char buf[100]; 453 454 sprintf(buf, "bad screen distance \"%.50s\"", string); 455 Tcl_ResetResult(interp); 456 Tcl_AppendResult(interp, buf, NULL); 457 } 458 return TCL_ERROR; 459} 460 461/* 462 *---------------------------------------------------------------------- 463 * 464 * Tk_GetMMFromObj -- 465 * 466 * Attempt to return an mm value from the Tcl object "objPtr". If the 467 * object is not already an mm value, an attempt will be made to convert 468 * it to one. 469 * 470 * Results: 471 * The return value is a standard Tcl object result. If an error occurs 472 * during conversion, an error message is left in the interpreter's 473 * result unless "interp" is NULL. 474 * 475 * Side effects: 476 * If the object is not already a pixel, the conversion will free any old 477 * internal representation. 478 * 479 *---------------------------------------------------------------------- 480 */ 481 482int 483Tk_GetMMFromObj( 484 Tcl_Interp *interp, /* Used for error reporting if not NULL. */ 485 Tk_Window tkwin, 486 Tcl_Obj *objPtr, /* The object from which to get mms. */ 487 double *doublePtr) /* Place to store resulting millimeters. */ 488{ 489 int result; 490 double d; 491 MMRep *mmPtr; 492 static double bias[] = { 493 10.0, 25.4, 1.0, 0.35278 /*25.4 / 72.0*/ 494 }; 495 496 if (objPtr->typePtr != &mmObjType) { 497 result = SetMMFromAny(interp, objPtr); 498 if (result != TCL_OK) { 499 return result; 500 } 501 } 502 503 mmPtr = (MMRep *) objPtr->internalRep.otherValuePtr; 504 if (mmPtr->tkwin != tkwin) { 505 d = mmPtr->value; 506 if (mmPtr->units == -1) { 507 d /= WidthOfScreen(Tk_Screen(tkwin)); 508 d *= WidthMMOfScreen(Tk_Screen(tkwin)); 509 } else { 510 d *= bias[mmPtr->units]; 511 } 512 mmPtr->tkwin = tkwin; 513 mmPtr->returnValue = d; 514 } 515 *doublePtr = mmPtr->returnValue; 516 517 return TCL_OK; 518} 519 520/* 521 *---------------------------------------------------------------------- 522 * 523 * FreeMMInternalRep -- 524 * 525 * Deallocate the storage associated with a mm object's internal 526 * representation. 527 * 528 * Results: 529 * None. 530 * 531 * Side effects: 532 * Frees objPtr's internal representation and sets objPtr's internalRep 533 * to NULL. 534 * 535 *---------------------------------------------------------------------- 536 */ 537 538static void 539FreeMMInternalRep( 540 Tcl_Obj *objPtr) /* MM object with internal rep to free. */ 541{ 542 ckfree((char *) objPtr->internalRep.otherValuePtr); 543 objPtr->internalRep.otherValuePtr = NULL; 544 objPtr->typePtr = NULL; 545} 546 547/* 548 *---------------------------------------------------------------------- 549 * 550 * DupMMInternalRep -- 551 * 552 * Initialize the internal representation of a pixel Tcl_Obj to a copy of 553 * the internal representation of an existing pixel object. 554 * 555 * Results: 556 * None. 557 * 558 * Side effects: 559 * copyPtr's internal rep is set to the pixel corresponding to srcPtr's 560 * internal rep. 561 * 562 *---------------------------------------------------------------------- 563 */ 564 565static void 566DupMMInternalRep( 567 register Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ 568 register Tcl_Obj *copyPtr) /* Object with internal rep to set. */ 569{ 570 MMRep *oldPtr, *newPtr; 571 572 copyPtr->typePtr = srcPtr->typePtr; 573 oldPtr = (MMRep *) srcPtr->internalRep.otherValuePtr; 574 newPtr = (MMRep *) ckalloc(sizeof(MMRep)); 575 newPtr->value = oldPtr->value; 576 newPtr->units = oldPtr->units; 577 newPtr->tkwin = oldPtr->tkwin; 578 newPtr->returnValue = oldPtr->returnValue; 579 copyPtr->internalRep.otherValuePtr = (VOID *) newPtr; 580} 581 582/* 583 *---------------------------------------------------------------------- 584 * 585 * UpdateStringOfMM -- 586 * 587 * Update the string representation for a pixel Tcl_Obj this function is 588 * only called, if the pixel Tcl_Obj has no unit, because with units the 589 * string representation is created by SetMMFromAny 590 * 591 * Results: 592 * None. 593 * 594 * Side effects: 595 * The object's string is set to a valid string that results from the 596 * double-to-string conversion. 597 * 598 *---------------------------------------------------------------------- 599 */ 600 601static void 602UpdateStringOfMM( 603 register Tcl_Obj *objPtr) /* pixel obj with string rep to update. */ 604{ 605 MMRep *mmPtr; 606 char buffer[TCL_DOUBLE_SPACE]; 607 register int len; 608 609 mmPtr = (MMRep *) objPtr->internalRep.otherValuePtr; 610 /* assert( mmPtr->units == -1 && objPtr->bytes == NULL ); */ 611 if ((mmPtr->units != -1) || (objPtr->bytes != NULL)) { 612 Tcl_Panic("UpdateStringOfMM: false precondition"); 613 } 614 615 Tcl_PrintDouble(NULL, mmPtr->value, buffer); 616 len = (int)strlen(buffer); 617 618 objPtr->bytes = (char *) ckalloc((unsigned) len + 1); 619 strcpy(objPtr->bytes, buffer); 620 objPtr->length = len; 621} 622 623/* 624 *---------------------------------------------------------------------- 625 * 626 * SetMMFromAny -- 627 * 628 * Attempt to generate a mm internal form for the Tcl object "objPtr". 629 * 630 * Results: 631 * The return value is a standard Tcl result. If an error occurs during 632 * conversion, an error message is left in the interpreter's result 633 * unless "interp" is NULL. 634 * 635 * Side effects: 636 * If no error occurs, a mm representation of the object is stored 637 * internally and the type of "objPtr" is set to mm. 638 * 639 *---------------------------------------------------------------------- 640 */ 641 642static int 643SetMMFromAny( 644 Tcl_Interp *interp, /* Used for error reporting if not NULL. */ 645 Tcl_Obj *objPtr) /* The object to convert. */ 646{ 647 const Tcl_ObjType *typePtr; 648 char *string, *rest; 649 double d; 650 int units; 651 MMRep *mmPtr; 652 653 static const Tcl_ObjType *tclDoubleObjType = NULL; 654 static const Tcl_ObjType *tclIntObjType = NULL; 655 656 if (tclDoubleObjType == NULL) { 657 /* 658 * Cache the object types for comaprison below. This allows optimized 659 * checks for standard cases. 660 */ 661 662 tclDoubleObjType = Tcl_GetObjType("double"); 663 tclIntObjType = Tcl_GetObjType("int"); 664 } 665 666 if (objPtr->typePtr == tclDoubleObjType) { 667 Tcl_GetDoubleFromObj(interp, objPtr, &d); 668 units = -1; 669 } else if (objPtr->typePtr == tclIntObjType) { 670 Tcl_GetIntFromObj(interp, objPtr, &units); 671 d = (double) units; 672 units = -1; 673 674 /* 675 * In the case of ints, we need to ensure that a valid string exists 676 * in order for int-but-not-string objects to be converted back to 677 * ints again from mm obj types. 678 */ 679 680 (void) Tcl_GetStringFromObj(objPtr, NULL); 681 } else { 682 /* 683 * It wasn't a known int or double, so parse it. 684 */ 685 686 string = Tcl_GetStringFromObj(objPtr, NULL); 687 688 d = strtod(string, &rest); 689 if (rest == string) { 690 /* 691 * Must copy string before resetting the result in case a caller 692 * is trying to convert the interpreter's result to mms. 693 */ 694 695 error: 696 Tcl_AppendResult(interp, "bad screen distance \"", string, 697 "\"", NULL); 698 return TCL_ERROR; 699 } 700 while ((*rest != '\0') && isspace(UCHAR(*rest))) { 701 rest++; 702 } 703 704 switch (*rest) { 705 case '\0': 706 units = -1; 707 break; 708 case 'c': 709 units = 0; 710 break; 711 case 'i': 712 units = 1; 713 break; 714 case 'm': 715 units = 2; 716 break; 717 case 'p': 718 units = 3; 719 break; 720 default: 721 goto error; 722 } 723 } 724 725 /* 726 * Free the old internalRep before setting the new one. 727 */ 728 729 typePtr = objPtr->typePtr; 730 if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) { 731 (*typePtr->freeIntRepProc)(objPtr); 732 } 733 734 objPtr->typePtr = &mmObjType; 735 736 mmPtr = (MMRep *) ckalloc(sizeof(MMRep)); 737 mmPtr->value = d; 738 mmPtr->units = units; 739 mmPtr->tkwin = NULL; 740 mmPtr->returnValue = d; 741 742 objPtr->internalRep.otherValuePtr = (VOID *) mmPtr; 743 744 return TCL_OK; 745} 746 747/* 748 *---------------------------------------------------------------------- 749 * 750 * TkGetWindowFromObj -- 751 * 752 * Attempt to return a Tk_Window from the Tcl object "objPtr". If the 753 * object is not already a Tk_Window, an attempt will be made to convert 754 * it to one. 755 * 756 * Results: 757 * The return value is a standard Tcl object result. If an error occurs 758 * during conversion, an error message is left in the interpreter's 759 * result unless "interp" is NULL. 760 * 761 * Side effects: 762 * If the object is not already a Tk_Window, the conversion will free any 763 * old internal representation. 764 * 765 *---------------------------------------------------------------------- 766 */ 767 768int 769TkGetWindowFromObj( 770 Tcl_Interp *interp, /* Used for error reporting if not NULL. */ 771 Tk_Window tkwin, /* A token to get the main window from. */ 772 Tcl_Obj *objPtr, /* The object from which to get window. */ 773 Tk_Window *windowPtr) /* Place to store resulting window. */ 774{ 775 TkMainInfo *mainPtr = ((TkWindow *)tkwin)->mainPtr; 776 register WindowRep *winPtr; 777 int result; 778 779 result = Tcl_ConvertToType(interp, objPtr, &windowObjType); 780 if (result != TCL_OK) { 781 return result; 782 } 783 784 winPtr = (WindowRep *) objPtr->internalRep.otherValuePtr; 785 if ( winPtr->tkwin == NULL 786 || winPtr->mainPtr == NULL 787 || winPtr->mainPtr != mainPtr 788 || winPtr->epoch != mainPtr->deletionEpoch) 789 { 790 /* Cache is invalid. 791 */ 792 winPtr->tkwin = Tk_NameToWindow(interp, 793 Tcl_GetStringFromObj(objPtr, NULL), tkwin); 794 winPtr->mainPtr = mainPtr; 795 winPtr->epoch = mainPtr ? mainPtr->deletionEpoch : 0; 796 } 797 798 *windowPtr = winPtr->tkwin; 799 800 if (winPtr->tkwin == NULL) { 801 /* ASSERT: Tk_NameToWindow has left error message in interp */ 802 return TCL_ERROR; 803 } 804 return TCL_OK; 805} 806 807/* 808 *---------------------------------------------------------------------- 809 * 810 * SetWindowFromAny -- 811 * 812 * Generate a windowObj internal form for the Tcl object "objPtr". 813 * 814 * Results: 815 * Always returns TCL_OK. 816 * 817 * Side effects: 818 * Sets objPtr's internal representation to an uninitialized windowObj. 819 * Frees the old internal representation, if any. 820 * 821 * See also: 822 * TkGetWindowFromObj, which initializes the WindowRep cache. 823 * 824 *---------------------------------------------------------------------- 825 */ 826 827static int 828SetWindowFromAny( 829 Tcl_Interp *interp, /* Used for error reporting if not NULL. */ 830 register Tcl_Obj *objPtr) /* The object to convert. */ 831{ 832 const Tcl_ObjType *typePtr; 833 WindowRep *winPtr; 834 835 /* 836 * Free the old internalRep before setting the new one. 837 */ 838 839 Tcl_GetStringFromObj(objPtr, NULL); 840 typePtr = objPtr->typePtr; 841 if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) { 842 (*typePtr->freeIntRepProc)(objPtr); 843 } 844 845 winPtr = (WindowRep *) ckalloc(sizeof(WindowRep)); 846 winPtr->tkwin = NULL; 847 winPtr->mainPtr = NULL; 848 winPtr->epoch = 0; 849 850 objPtr->internalRep.otherValuePtr = (VOID*)winPtr; 851 objPtr->typePtr = &windowObjType; 852 853 return TCL_OK; 854} 855 856/* 857 *---------------------------------------------------------------------- 858 * 859 * DupWindowInternalRep -- 860 * 861 * Initialize the internal representation of a window Tcl_Obj to a copy 862 * of the internal representation of an existing window object. 863 * 864 * Results: 865 * None. 866 * 867 * Side effects: 868 * copyPtr's internal rep is set to refer to the same window as srcPtr's 869 * internal rep. 870 * 871 *---------------------------------------------------------------------- 872 */ 873 874static void 875DupWindowInternalRep( 876 register Tcl_Obj *srcPtr, 877 register Tcl_Obj *copyPtr) 878{ 879 register WindowRep *oldPtr, *newPtr; 880 881 oldPtr = srcPtr->internalRep.otherValuePtr; 882 newPtr = (WindowRep *) ckalloc(sizeof(WindowRep)); 883 newPtr->tkwin = oldPtr->tkwin; 884 newPtr->mainPtr = oldPtr->mainPtr; 885 newPtr->epoch = oldPtr->epoch; 886 copyPtr->internalRep.otherValuePtr = (VOID *)newPtr; 887 copyPtr->typePtr = srcPtr->typePtr; 888} 889 890/* 891 *---------------------------------------------------------------------- 892 * 893 * FreeWindowInternalRep -- 894 * 895 * Deallocate the storage associated with a window object's internal 896 * representation. 897 * 898 * Results: 899 * None. 900 * 901 * Side effects: 902 * Frees objPtr's internal representation and sets objPtr's internalRep 903 * to NULL. 904 * 905 *---------------------------------------------------------------------- 906 */ 907 908static void 909FreeWindowInternalRep( 910 Tcl_Obj *objPtr) /* Window object with internal rep to free. */ 911{ 912 ckfree((char *) objPtr->internalRep.otherValuePtr); 913 objPtr->internalRep.otherValuePtr = NULL; 914 objPtr->typePtr = NULL; 915} 916 917/* 918 *-------------------------------------------------------------- 919 * 920 * TkParsePadAmount -- 921 * 922 * This function parses a padding specification and returns the 923 * appropriate padding values. A padding specification can be either a 924 * single pixel width, or a list of two pixel widths. If a single pixel 925 * width, the amount specified is used for padding on both sides. If two 926 * amounts are specified, then they specify the left/right or top/bottom 927 * padding. 928 * 929 * Results: 930 * A standard Tcl return value. 931 * 932 * Side effects: 933 * An error message is written to the interpreter if something is not 934 * right. 935 * 936 *-------------------------------------------------------------- 937 */ 938 939int 940TkParsePadAmount( 941 Tcl_Interp *interp, /* Interpreter for error reporting. */ 942 Tk_Window tkwin, /* A window. Needed by Tk_GetPixels() */ 943 Tcl_Obj *specObj, /* The argument to "-padx", "-pady", "-ipadx", 944 * or "-ipady". The thing to be parsed. */ 945 int *halfPtr, /* Write the left/top part of padding here */ 946 int *allPtr) /* Write the total padding here */ 947{ 948 int firstInt, secondInt; /* The two components of the padding */ 949 int objc; /* The length of the list (should be 1 or 2) */ 950 Tcl_Obj **objv; /* The objects in the list */ 951 952 /* 953 * Check for a common case where a single object would otherwise 954 * be shimmered between a list and a pixel spec. 955 */ 956 957 if (specObj->typePtr == &pixelObjType) { 958 if (Tk_GetPixelsFromObj(interp, tkwin, specObj, &firstInt) != TCL_OK) { 959 Tcl_ResetResult(interp); 960 Tcl_AppendResult(interp, "bad pad value \"", 961 Tcl_GetString(specObj), 962 "\": must be positive screen distance", NULL); 963 return TCL_ERROR; 964 } 965 secondInt = firstInt; 966 goto done; 967 } 968 969 /* 970 * Pad specifications are a list of one or two elements, each of which is 971 * a pixel specification. 972 */ 973 974 if (Tcl_ListObjGetElements(interp, specObj, &objc, &objv) != TCL_OK) { 975 return TCL_ERROR; 976 } 977 if (objc != 1 && objc != 2) { 978 Tcl_AppendResult(interp, 979 "wrong number of parts to pad specification", NULL); 980 return TCL_ERROR; 981 } 982 983 /* 984 * Parse the first part. 985 */ 986 987 if (Tk_GetPixelsFromObj(interp, tkwin, objv[0], &firstInt) != TCL_OK || 988 (firstInt < 0)) { 989 Tcl_ResetResult(interp); 990 Tcl_AppendResult(interp, "bad pad value \"", Tcl_GetString(objv[0]), 991 "\": must be positive screen distance", NULL); 992 return TCL_ERROR; 993 } 994 995 /* 996 * Parse the second part if it exists, otherwise it is as if it was the 997 * same as the first part. 998 */ 999 1000 if (objc == 1) { 1001 secondInt = firstInt; 1002 } else if (Tk_GetPixelsFromObj(interp, tkwin, objv[1], 1003 &secondInt) != TCL_OK || (secondInt < 0)) { 1004 Tcl_ResetResult(interp); 1005 Tcl_AppendResult(interp, "bad 2nd pad value \"", 1006 Tcl_GetString(objv[1]), 1007 "\": must be positive screen distance", NULL); 1008 return TCL_ERROR; 1009 } 1010 1011 /* 1012 * Write the parsed bits back into the receiving variables. 1013 */ 1014 1015 done: 1016 if (halfPtr != 0) { 1017 *halfPtr = firstInt; 1018 } 1019 *allPtr = firstInt + secondInt; 1020 return TCL_OK; 1021} 1022 1023/* 1024 *---------------------------------------------------------------------- 1025 * 1026 * TkRegisterObjTypes -- 1027 * 1028 * Registers Tk's Tcl_ObjType structures with the Tcl run-time. 1029 * 1030 * Results: 1031 * None 1032 * 1033 * Side effects: 1034 * All instances of Tcl_ObjType structues used in Tk are registered with 1035 * Tcl. 1036 * 1037 *---------------------------------------------------------------------- 1038 */ 1039 1040void 1041TkRegisterObjTypes(void) 1042{ 1043 Tcl_RegisterObjType(&tkBorderObjType); 1044 Tcl_RegisterObjType(&tkBitmapObjType); 1045 Tcl_RegisterObjType(&tkColorObjType); 1046 Tcl_RegisterObjType(&tkCursorObjType); 1047 Tcl_RegisterObjType(&tkFontObjType); 1048 Tcl_RegisterObjType(&mmObjType); 1049 Tcl_RegisterObjType(&tkOptionObjType); 1050 Tcl_RegisterObjType(&pixelObjType); 1051 Tcl_RegisterObjType(&tkStateKeyObjType); 1052 Tcl_RegisterObjType(&windowObjType); 1053 Tcl_RegisterObjType(&tkTextIndexType); 1054} 1055 1056/* 1057 * Local Variables: 1058 * mode: c 1059 * c-basic-offset: 4 1060 * fill-column: 78 1061 * End: 1062 */ 1063