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