1/* 2 * tkColor.c -- 3 * 4 * This file maintains a database of color values for the Tk toolkit, in 5 * order to avoid round-trips to the server to map color names to pixel 6 * values. 7 * 8 * Copyright (c) 1990-1994 The Regents of the University of California. 9 * Copyright (c) 1994-1997 Sun Microsystems, Inc. 10 * 11 * See the file "license.terms" for information on usage and redistribution of 12 * this file, and for a DISCLAIMER OF ALL WARRANTIES. 13 * 14 * RCS: @(#) $Id$ 15 */ 16 17#include "tkInt.h" 18#include "tkColor.h" 19 20/* 21 * Structures of the following following type are used as keys for 22 * colorValueTable (in TkDisplay). 23 */ 24 25typedef struct { 26 int red, green, blue; /* Values for desired color. */ 27 Colormap colormap; /* Colormap from which color will be 28 * allocated. */ 29 Display *display; /* Display for colormap. */ 30} ValueKey; 31 32/* 33 * The structure below is used to allocate thread-local data. 34 */ 35 36typedef struct ThreadSpecificData { 37 char rgbString[20]; /* */ 38} ThreadSpecificData; 39static Tcl_ThreadDataKey dataKey; 40 41/* 42 * Forward declarations for functions defined in this file: 43 */ 44 45static void ColorInit(TkDisplay *dispPtr); 46static void DupColorObjProc(Tcl_Obj *srcObjPtr,Tcl_Obj *dupObjPtr); 47static void FreeColorObjProc(Tcl_Obj *objPtr); 48static void InitColorObj(Tcl_Obj *objPtr); 49 50/* 51 * The following structure defines the implementation of the "color" Tcl 52 * object, which maps a string color name to a TkColor object. The ptr1 field 53 * of the Tcl_Obj points to a TkColor object. 54 */ 55 56Tcl_ObjType tkColorObjType = { 57 "color", /* name */ 58 FreeColorObjProc, /* freeIntRepProc */ 59 DupColorObjProc, /* dupIntRepProc */ 60 NULL, /* updateStringProc */ 61 NULL /* setFromAnyProc */ 62}; 63 64/* 65 *---------------------------------------------------------------------- 66 * 67 * Tk_AllocColorFromObj -- 68 * 69 * Given a Tcl_Obj *, map the value to a corresponding XColor structure 70 * based on the tkwin given. 71 * 72 * Results: 73 * The return value is a pointer to an XColor structure that indicates 74 * the red, blue, and green intensities for the color given by the string 75 * in objPtr, and also specifies a pixel value to use to draw in that 76 * color. If an error occurs, NULL is returned and an error message will 77 * be left in interp's result (unless interp is NULL). 78 * 79 * Side effects: 80 * The color is added to an internal database with a reference count. For 81 * each call to this function, there should eventually be a call to 82 * Tk_FreeColorFromObj so that the database is cleaned up when colors 83 * aren't in use anymore. 84 * 85 *---------------------------------------------------------------------- 86 */ 87 88XColor * 89Tk_AllocColorFromObj( 90 Tcl_Interp *interp, /* Used only for error reporting. If NULL, 91 * then no messages are provided. */ 92 Tk_Window tkwin, /* Window in which the color will be used.*/ 93 Tcl_Obj *objPtr) /* Object that describes the color; string 94 * value is a color name such as "red" or 95 * "#ff0000".*/ 96{ 97 TkColor *tkColPtr; 98 99 if (objPtr->typePtr != &tkColorObjType) { 100 InitColorObj(objPtr); 101 } 102 tkColPtr = (TkColor *) objPtr->internalRep.twoPtrValue.ptr1; 103 104 /* 105 * If the object currently points to a TkColor, see if it's the one we 106 * want. If so, increment its reference count and return. 107 */ 108 109 if (tkColPtr != NULL) { 110 if (tkColPtr->resourceRefCount == 0) { 111 /* 112 * This is a stale reference: it refers to a TkColor that's no 113 * longer in use. Clear the reference. 114 */ 115 116 FreeColorObjProc(objPtr); 117 tkColPtr = NULL; 118 } else if ((Tk_Screen(tkwin) == tkColPtr->screen) 119 && (Tk_Colormap(tkwin) == tkColPtr->colormap)) { 120 tkColPtr->resourceRefCount++; 121 return (XColor *) tkColPtr; 122 } 123 } 124 125 /* 126 * The object didn't point to the TkColor that we wanted. Search the list 127 * of TkColors with the same name to see if one of the other TkColors is 128 * the right one. 129 */ 130 131 if (tkColPtr != NULL) { 132 TkColor *firstColorPtr = Tcl_GetHashValue(tkColPtr->hashPtr); 133 134 FreeColorObjProc(objPtr); 135 for (tkColPtr = firstColorPtr; tkColPtr != NULL; 136 tkColPtr = tkColPtr->nextPtr) { 137 if ((Tk_Screen(tkwin) == tkColPtr->screen) 138 && (Tk_Colormap(tkwin) == tkColPtr->colormap)) { 139 tkColPtr->resourceRefCount++; 140 tkColPtr->objRefCount++; 141 objPtr->internalRep.twoPtrValue.ptr1 = (void *) tkColPtr; 142 return (XColor *) tkColPtr; 143 } 144 } 145 } 146 147 /* 148 * Still no luck. Call Tk_GetColor to allocate a new TkColor object. 149 */ 150 151 tkColPtr = (TkColor *) Tk_GetColor(interp, tkwin, Tcl_GetString(objPtr)); 152 objPtr->internalRep.twoPtrValue.ptr1 = (void *) tkColPtr; 153 if (tkColPtr != NULL) { 154 tkColPtr->objRefCount++; 155 } 156 return (XColor *) tkColPtr; 157} 158 159/* 160 *---------------------------------------------------------------------- 161 * 162 * Tk_GetColor -- 163 * 164 * Given a string name for a color, map the name to a corresponding 165 * XColor structure. 166 * 167 * Results: 168 * The return value is a pointer to an XColor structure that indicates 169 * the red, blue, and green intensities for the color given by "name", 170 * and also specifies a pixel value to use to draw in that color. If an 171 * error occurs, NULL is returned and an error message will be left in 172 * the interp's result. 173 * 174 * Side effects: 175 * The color is added to an internal database with a reference count. For 176 * each call to this function, there should eventually be a call to 177 * Tk_FreeColor so that the database is cleaned up when colors aren't in 178 * use anymore. 179 * 180 *---------------------------------------------------------------------- 181 */ 182 183XColor * 184Tk_GetColor( 185 Tcl_Interp *interp, /* Place to leave error message if color can't 186 * be found. */ 187 Tk_Window tkwin, /* Window in which color will be used. */ 188 Tk_Uid name) /* Name of color to be allocated (in form 189 * suitable for passing to XParseColor). */ 190{ 191 Tcl_HashEntry *nameHashPtr; 192 int isNew; 193 TkColor *tkColPtr; 194 TkColor *existingColPtr; 195 TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; 196 197 if (!dispPtr->colorInit) { 198 ColorInit(dispPtr); 199 } 200 201 /* 202 * First, check to see if there's already a mapping for this color name. 203 */ 204 205 nameHashPtr = Tcl_CreateHashEntry(&dispPtr->colorNameTable, name, &isNew); 206 if (!isNew) { 207 existingColPtr = Tcl_GetHashValue(nameHashPtr); 208 for (tkColPtr = existingColPtr; tkColPtr != NULL; 209 tkColPtr = tkColPtr->nextPtr) { 210 if ((tkColPtr->screen == Tk_Screen(tkwin)) 211 && (Tk_Colormap(tkwin) == tkColPtr->colormap)) { 212 tkColPtr->resourceRefCount++; 213 return &tkColPtr->color; 214 } 215 } 216 } else { 217 existingColPtr = NULL; 218 } 219 220 /* 221 * The name isn't currently known. Map from the name to a pixel value. 222 */ 223 224 tkColPtr = TkpGetColor(tkwin, name); 225 if (tkColPtr == NULL) { 226 if (interp != NULL) { 227 if (*name == '#') { 228 Tcl_AppendResult(interp, "invalid color name \"", name, 229 "\"", NULL); 230 } else { 231 Tcl_AppendResult(interp, "unknown color name \"", name, 232 "\"", NULL); 233 } 234 } 235 if (isNew) { 236 Tcl_DeleteHashEntry(nameHashPtr); 237 } 238 return NULL; 239 } 240 241 /* 242 * Now create a new TkColor structure and add it to colorNameTable (in 243 * TkDisplay). 244 */ 245 246 tkColPtr->magic = COLOR_MAGIC; 247 tkColPtr->gc = None; 248 tkColPtr->screen = Tk_Screen(tkwin); 249 tkColPtr->colormap = Tk_Colormap(tkwin); 250 tkColPtr->visual = Tk_Visual(tkwin); 251 tkColPtr->resourceRefCount = 1; 252 tkColPtr->objRefCount = 0; 253 tkColPtr->type = TK_COLOR_BY_NAME; 254 tkColPtr->hashPtr = nameHashPtr; 255 tkColPtr->nextPtr = existingColPtr; 256 Tcl_SetHashValue(nameHashPtr, tkColPtr); 257 258 return &tkColPtr->color; 259} 260 261/* 262 *---------------------------------------------------------------------- 263 * 264 * Tk_GetColorByValue -- 265 * 266 * Given a desired set of red-green-blue intensities for a color, locate 267 * a pixel value to use to draw that color in a given window. 268 * 269 * Results: 270 * The return value is a pointer to an XColor structure that indicates 271 * the closest red, blue, and green intensities available to those 272 * specified in colorPtr, and also specifies a pixel value to use to draw 273 * in that color. 274 * 275 * Side effects: 276 * The color is added to an internal database with a reference count. For 277 * each call to this function, there should eventually be a call to 278 * Tk_FreeColor, so that the database is cleaned up when colors aren't in 279 * use anymore. 280 * 281 *---------------------------------------------------------------------- 282 */ 283 284XColor * 285Tk_GetColorByValue( 286 Tk_Window tkwin, /* Window where color will be used. */ 287 XColor *colorPtr) /* Red, green, and blue fields indicate 288 * desired color. */ 289{ 290 ValueKey valueKey; 291 Tcl_HashEntry *valueHashPtr; 292 int isNew; 293 TkColor *tkColPtr; 294 Display *display = Tk_Display(tkwin); 295 TkDisplay *dispPtr = TkGetDisplay(display); 296 297 if (!dispPtr->colorInit) { 298 ColorInit(dispPtr); 299 } 300 301 /* 302 * First, check to see if there's already a mapping for this color name. 303 * Must clear the structure first; it's not tightly packed on 64-bit 304 * systems. [Bug 2911570] 305 */ 306 307 memset(&valueKey, 0, sizeof(ValueKey)); 308 valueKey.red = colorPtr->red; 309 valueKey.green = colorPtr->green; 310 valueKey.blue = colorPtr->blue; 311 valueKey.colormap = Tk_Colormap(tkwin); 312 valueKey.display = display; 313 valueHashPtr = Tcl_CreateHashEntry(&dispPtr->colorValueTable, 314 (char *) &valueKey, &isNew); 315 if (!isNew) { 316 tkColPtr = Tcl_GetHashValue(valueHashPtr); 317 tkColPtr->resourceRefCount++; 318 return &tkColPtr->color; 319 } 320 321 /* 322 * The name isn't currently known. Find a pixel value for this color and 323 * add a new structure to colorValueTable (in TkDisplay). 324 */ 325 326 tkColPtr = TkpGetColorByValue(tkwin, colorPtr); 327 tkColPtr->magic = COLOR_MAGIC; 328 tkColPtr->gc = None; 329 tkColPtr->screen = Tk_Screen(tkwin); 330 tkColPtr->colormap = valueKey.colormap; 331 tkColPtr->visual = Tk_Visual(tkwin); 332 tkColPtr->resourceRefCount = 1; 333 tkColPtr->objRefCount = 0; 334 tkColPtr->type = TK_COLOR_BY_VALUE; 335 tkColPtr->hashPtr = valueHashPtr; 336 tkColPtr->nextPtr = NULL; 337 Tcl_SetHashValue(valueHashPtr, tkColPtr); 338 return &tkColPtr->color; 339} 340 341/* 342 *-------------------------------------------------------------- 343 * 344 * Tk_NameOfColor -- 345 * 346 * Given a color, return a textual string identifying the color. 347 * 348 * Results: 349 * If colorPtr was created by Tk_GetColor, then the return value is the 350 * "string" that was used to create it. Otherwise the return value is a 351 * string that could have been passed to Tk_GetColor to allocate that 352 * color. The storage for the returned string is only guaranteed to 353 * persist up until the next call to this function. 354 * 355 * Side effects: 356 * None. 357 * 358 *-------------------------------------------------------------- 359 */ 360 361CONST char * 362Tk_NameOfColor( 363 XColor *colorPtr) /* Color whose name is desired. */ 364{ 365 register TkColor *tkColPtr = (TkColor *) colorPtr; 366 367 if (tkColPtr->magic==COLOR_MAGIC && tkColPtr->type==TK_COLOR_BY_NAME) { 368 return tkColPtr->hashPtr->key.string; 369 } else { 370 ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 371 Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); 372 373 sprintf(tsdPtr->rgbString, "#%04x%04x%04x", colorPtr->red, 374 colorPtr->green, colorPtr->blue); 375 return tsdPtr->rgbString; 376 } 377} 378 379/* 380 *---------------------------------------------------------------------- 381 * 382 * Tk_GCForColor -- 383 * 384 * Given a color allocated from this module, this function returns a GC 385 * that can be used for simple drawing with that color. 386 * 387 * Results: 388 * The return value is a GC with color set as its foreground color and 389 * all other fields defaulted. This GC is only valid as long as the color 390 * exists; it is freed automatically when the last reference to the color 391 * is freed. 392 * 393 * Side effects: 394 * None. 395 * 396 *---------------------------------------------------------------------- 397 */ 398 399GC 400Tk_GCForColor( 401 XColor *colorPtr, /* Color for which a GC is desired. Must have 402 * been allocated by Tk_GetColor. */ 403 Drawable drawable) /* Drawable in which the color will be used 404 * (must have same screen and depth as the one 405 * for which the color was allocated). */ 406{ 407 TkColor *tkColPtr = (TkColor *) colorPtr; 408 XGCValues gcValues; 409 410 /* 411 * Do a quick sanity check to make sure this color was really allocated by 412 * Tk_GetColor. 413 */ 414 415 if (tkColPtr->magic != COLOR_MAGIC) { 416 Tcl_Panic("Tk_GCForColor called with bogus color"); 417 } 418 419 if (tkColPtr->gc == None) { 420 gcValues.foreground = tkColPtr->color.pixel; 421 tkColPtr->gc = XCreateGC(DisplayOfScreen(tkColPtr->screen), 422 drawable, GCForeground, &gcValues); 423 } 424 return tkColPtr->gc; 425} 426 427/* 428 *---------------------------------------------------------------------- 429 * 430 * Tk_FreeColor -- 431 * 432 * This function is called to release a color allocated by Tk_GetColor. 433 * 434 * Results: 435 * None. 436 * 437 * Side effects: 438 * The reference count associated with colorPtr is deleted, and the color 439 * is released to X if there are no remaining uses for it. 440 * 441 *---------------------------------------------------------------------- 442 */ 443 444void 445Tk_FreeColor( 446 XColor *colorPtr) /* Color to be released. Must have been 447 * allocated by Tk_GetColor or 448 * Tk_GetColorByValue. */ 449{ 450 TkColor *tkColPtr = (TkColor *) colorPtr; 451 Screen *screen = tkColPtr->screen; 452 TkColor *prevPtr; 453 454 /* 455 * Do a quick sanity check to make sure this color was really allocated by 456 * Tk_GetColor. 457 */ 458 459 if (tkColPtr->magic != COLOR_MAGIC) { 460 Tcl_Panic("Tk_FreeColor called with bogus color"); 461 } 462 463 tkColPtr->resourceRefCount--; 464 if (tkColPtr->resourceRefCount > 0) { 465 return; 466 } 467 468 /* 469 * This color is no longer being actively used, so free the color 470 * resources associated with it and remove it from the hash table. No 471 * longer any objects referencing it. 472 */ 473 474 if (tkColPtr->gc != None) { 475 XFreeGC(DisplayOfScreen(screen), tkColPtr->gc); 476 tkColPtr->gc = None; 477 } 478 TkpFreeColor(tkColPtr); 479 480 prevPtr = Tcl_GetHashValue(tkColPtr->hashPtr); 481 if (prevPtr == tkColPtr) { 482 if (tkColPtr->nextPtr == NULL) { 483 Tcl_DeleteHashEntry(tkColPtr->hashPtr); 484 } else { 485 Tcl_SetHashValue(tkColPtr->hashPtr, tkColPtr->nextPtr); 486 } 487 } else { 488 while (prevPtr->nextPtr != tkColPtr) { 489 prevPtr = prevPtr->nextPtr; 490 } 491 prevPtr->nextPtr = tkColPtr->nextPtr; 492 } 493 494 /* 495 * Free the TkColor structure if there are no objects referencing it. 496 * However, if there are objects referencing it then keep the structure 497 * around; it will get freed when the last reference is cleared 498 */ 499 500 if (tkColPtr->objRefCount == 0) { 501 ckfree((char *) tkColPtr); 502 } 503} 504 505/* 506 *---------------------------------------------------------------------- 507 * 508 * Tk_FreeColorFromObj -- 509 * 510 * This function is called to release a color allocated by 511 * Tk_AllocColorFromObj. It does not throw away the Tcl_Obj *; it only 512 * gets rid of the hash table entry for this color and clears the cached 513 * value that is normally stored in the object. 514 * 515 * Results: 516 * None. 517 * 518 * Side effects: 519 * The reference count associated with the color represented by objPtr is 520 * decremented, and the color is released to X if there are no remaining 521 * uses for it. 522 * 523 *---------------------------------------------------------------------- 524 */ 525 526void 527Tk_FreeColorFromObj( 528 Tk_Window tkwin, /* The window this color lives in. Needed for 529 * the screen and colormap values. */ 530 Tcl_Obj *objPtr) /* The Tcl_Obj * to be freed. */ 531{ 532 Tk_FreeColor(Tk_GetColorFromObj(tkwin, objPtr)); 533 FreeColorObjProc(objPtr); 534} 535 536/* 537 *--------------------------------------------------------------------------- 538 * 539 * FreeColorObjProc -- 540 * 541 * This proc is called to release an object reference to a color. Called 542 * when the object's internal rep is released or when the cached tkColPtr 543 * needs to be changed. 544 * 545 * Results: 546 * None. 547 * 548 * Side effects: 549 * The object reference count is decremented. When both it and the hash 550 * ref count go to zero, the color's resources are released. 551 * 552 *--------------------------------------------------------------------------- 553 */ 554 555static void 556FreeColorObjProc( 557 Tcl_Obj *objPtr) /* The object we are releasing. */ 558{ 559 TkColor *tkColPtr = (TkColor *) objPtr->internalRep.twoPtrValue.ptr1; 560 561 if (tkColPtr != NULL) { 562 tkColPtr->objRefCount--; 563 if ((tkColPtr->objRefCount == 0) 564 && (tkColPtr->resourceRefCount == 0)) { 565 ckfree((char *) tkColPtr); 566 } 567 objPtr->internalRep.twoPtrValue.ptr1 = NULL; 568 } 569} 570 571/* 572 *--------------------------------------------------------------------------- 573 * 574 * DupColorObjProc -- 575 * 576 * When a cached color object is duplicated, this is called to update the 577 * internal reps. 578 * 579 * Results: 580 * None. 581 * 582 * Side effects: 583 * The color's objRefCount is incremented and the internal rep of the 584 * copy is set to point to it. 585 * 586 *--------------------------------------------------------------------------- 587 */ 588 589static void 590DupColorObjProc( 591 Tcl_Obj *srcObjPtr, /* The object we are copying from. */ 592 Tcl_Obj *dupObjPtr) /* The object we are copying to. */ 593{ 594 TkColor *tkColPtr = (TkColor *) srcObjPtr->internalRep.twoPtrValue.ptr1; 595 596 dupObjPtr->typePtr = srcObjPtr->typePtr; 597 dupObjPtr->internalRep.twoPtrValue.ptr1 = (void *) tkColPtr; 598 599 if (tkColPtr != NULL) { 600 tkColPtr->objRefCount++; 601 } 602} 603 604/* 605 *---------------------------------------------------------------------- 606 * 607 * Tk_GetColorFromObj -- 608 * 609 * Returns the color referred to by a Tcl object. The color must already 610 * have been allocated via a call to Tk_AllocColorFromObj or Tk_GetColor. 611 * 612 * Results: 613 * Returns the XColor * that matches the tkwin and the string rep of 614 * objPtr. 615 * 616 * Side effects: 617 * If the object is not already a color, the conversion will free any old 618 * internal representation. 619 * 620 *---------------------------------------------------------------------- 621 */ 622 623XColor * 624Tk_GetColorFromObj( 625 Tk_Window tkwin, /* The window in which the color will be 626 * used. */ 627 Tcl_Obj *objPtr) /* String value contains the name of the 628 * desired color. */ 629{ 630 TkColor *tkColPtr; 631 Tcl_HashEntry *hashPtr; 632 TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; 633 634 if (objPtr->typePtr != &tkColorObjType) { 635 InitColorObj(objPtr); 636 } 637 638 /* 639 * First check to see if the internal representation of the object is 640 * defined and is a color that is valid for the current screen and color 641 * map. If it is, we are done. 642 */ 643 644 tkColPtr = (TkColor *) objPtr->internalRep.twoPtrValue.ptr1; 645 if ((tkColPtr != NULL) 646 && (tkColPtr->resourceRefCount > 0) 647 && (Tk_Screen(tkwin) == tkColPtr->screen) 648 && (Tk_Colormap(tkwin) == tkColPtr->colormap)) { 649 /* 650 * The object already points to the right TkColor structure. Just 651 * return it. 652 */ 653 654 return (XColor *) tkColPtr; 655 } 656 657 /* 658 * If we reach this point, it means that the TkColor structure that we 659 * have cached in the internal representation is not valid for the current 660 * screen and colormap. But there is a list of other TkColor structures 661 * attached to the TkDisplay. Walk this list looking for the right TkColor 662 * structure. 663 */ 664 665 hashPtr = Tcl_FindHashEntry(&dispPtr->colorNameTable, 666 Tcl_GetString(objPtr)); 667 if (hashPtr == NULL) { 668 goto error; 669 } 670 for (tkColPtr = Tcl_GetHashValue(hashPtr); 671 (tkColPtr != NULL); tkColPtr = tkColPtr->nextPtr) { 672 if ((Tk_Screen(tkwin) == tkColPtr->screen) 673 && (Tk_Colormap(tkwin) == tkColPtr->colormap)) { 674 FreeColorObjProc(objPtr); 675 objPtr->internalRep.twoPtrValue.ptr1 = (void *) tkColPtr; 676 tkColPtr->objRefCount++; 677 return (XColor *) tkColPtr; 678 } 679 } 680 681 error: 682 Tcl_Panic("Tk_GetColorFromObj called with non-existent color!"); 683 /* 684 * The following code isn't reached; it's just there to please compilers. 685 */ 686 return NULL; 687} 688 689/* 690 *---------------------------------------------------------------------- 691 * 692 * InitColorObj -- 693 * 694 * Bookeeping function to change an objPtr to a color type. 695 * 696 * Results: 697 * None. 698 * 699 * Side effects: 700 * The old internal rep of the object is freed. The object's type is set 701 * to color with a NULL TkColor pointer (the pointer will be set later by 702 * either Tk_AllocColorFromObj or Tk_GetColorFromObj). 703 * 704 *---------------------------------------------------------------------- 705 */ 706 707static void 708InitColorObj( 709 Tcl_Obj *objPtr) /* The object to convert. */ 710{ 711 const Tcl_ObjType *typePtr; 712 713 /* 714 * Free the old internalRep before setting the new one. 715 */ 716 717 Tcl_GetString(objPtr); 718 typePtr = objPtr->typePtr; 719 if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) { 720 (*typePtr->freeIntRepProc)(objPtr); 721 } 722 objPtr->typePtr = &tkColorObjType; 723 objPtr->internalRep.twoPtrValue.ptr1 = NULL; 724} 725 726/* 727 *---------------------------------------------------------------------- 728 * 729 * ColorInit -- 730 * 731 * Initialize the structure used for color management. 732 * 733 * Results: 734 * None. 735 * 736 * Side effects: 737 * Read the code. 738 * 739 *---------------------------------------------------------------------- 740 */ 741 742static void 743ColorInit( 744 TkDisplay *dispPtr) 745{ 746 if (!dispPtr->colorInit) { 747 dispPtr->colorInit = 1; 748 Tcl_InitHashTable(&dispPtr->colorNameTable, TCL_STRING_KEYS); 749 Tcl_InitHashTable(&dispPtr->colorValueTable, 750 sizeof(ValueKey)/sizeof(int)); 751 } 752} 753 754/* 755 *---------------------------------------------------------------------- 756 * 757 * TkDebugColor -- 758 * 759 * This function returns debugging information about a color. 760 * 761 * Results: 762 * The return value is a list with one sublist for each TkColor 763 * corresponding to "name". Each sublist has two elements that contain 764 * the resourceRefCount and objRefCount fields from the TkColor 765 * structure. 766 * 767 * Side effects: 768 * None. 769 * 770 *---------------------------------------------------------------------- 771 */ 772 773Tcl_Obj * 774TkDebugColor( 775 Tk_Window tkwin, /* The window in which the color will be used 776 * (not currently used). */ 777 char *name) /* Name of the desired color. */ 778{ 779 Tcl_HashEntry *hashPtr; 780 Tcl_Obj *resultPtr; 781 TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; 782 783 resultPtr = Tcl_NewObj(); 784 hashPtr = Tcl_FindHashEntry(&dispPtr->colorNameTable, name); 785 if (hashPtr != NULL) { 786 TkColor *tkColPtr = Tcl_GetHashValue(hashPtr); 787 788 if (tkColPtr == NULL) { 789 Tcl_Panic("TkDebugColor found empty hash table entry"); 790 } 791 for ( ; (tkColPtr != NULL); tkColPtr = tkColPtr->nextPtr) { 792 Tcl_Obj *objPtr = Tcl_NewObj(); 793 794 Tcl_ListObjAppendElement(NULL, objPtr, 795 Tcl_NewIntObj(tkColPtr->resourceRefCount)); 796 Tcl_ListObjAppendElement(NULL, objPtr, 797 Tcl_NewIntObj(tkColPtr->objRefCount)); 798 Tcl_ListObjAppendElement(NULL, resultPtr, objPtr); 799 } 800 } 801 return resultPtr; 802} 803 804/* 805 * Local Variables: 806 * mode: c 807 * c-basic-offset: 4 808 * fill-column: 78 809 * End: 810 */ 811