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