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