diff options
Diffstat (limited to 'tk/generic/tkColor.c')
| -rw-r--r-- | tk/generic/tkColor.c | 650 |
1 files changed, 471 insertions, 179 deletions
diff --git a/tk/generic/tkColor.c b/tk/generic/tkColor.c index c5844781015..19659fcf159 100644 --- a/tk/generic/tkColor.c +++ b/tk/generic/tkColor.c @@ -6,7 +6,7 @@ * map color names to pixel values. * * Copyright (c) 1990-1994 The Regents of the University of California. - * Copyright (c) 1994-1995 Sun Microsystems, Inc. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -14,72 +14,149 @@ * RCS: @(#) $Id$ */ -#include <tkColor.h> +#include "tkColor.h" /* - * A two-level data structure is used to manage the color database. - * The top level consists of one entry for each color name that is - * currently active, and the bottom level contains one entry for each - * pixel value that is still in use. The distinction between - * levels is necessary because the same pixel may have several - * different names. There are two hash tables, one used to index into - * each of the data structures. The name hash table is used when - * allocating colors, and the pixel hash table is used when freeing - * colors. + * Structures of the following following type are used as keys for + * colorValueTable (in TkDisplay). */ - -/* - * Hash table for name -> TkColor mapping, and key structure used to - * index into that table: - */ - -static Tcl_HashTable nameTable; typedef struct { - Tk_Uid name; /* Name of desired color. */ + int red, green, blue; /* Values for desired color. */ Colormap colormap; /* Colormap from which color will be * allocated. */ Display *display; /* Display for colormap. */ -} NameKey; +} ValueKey; + /* - * Hash table for value -> TkColor mapping, and key structure used to - * index into that table: + * The structure below is used to allocate thread-local data. */ -static Tcl_HashTable valueTable; -typedef struct { - int red, green, blue; /* Values for desired color. */ - Colormap colormap; /* Colormap from which color will be - * allocated. */ - Display *display; /* Display for colormap. */ -} ValueKey; - -static int initialized = 0; /* 0 means static structures haven't been - * initialized yet. */ +typedef struct ThreadSpecificData { + char rgbString[20]; /* */ +} ThreadSpecificData; +static Tcl_ThreadDataKey dataKey; /* * Forward declarations for procedures defined in this file: */ -static void ColorInit _ANSI_ARGS_((void)); +static void ColorInit _ANSI_ARGS_((TkDisplay *dispPtr)); +static void DupColorObjProc _ANSI_ARGS_((Tcl_Obj *srcObjPtr, + Tcl_Obj *dupObjPtr)); +static void FreeColorObjProc _ANSI_ARGS_((Tcl_Obj *objPtr)); +static void InitColorObj _ANSI_ARGS_((Tcl_Obj *objPtr)); -/* CYGNUS LOCAL. */ - -/* A linked list of GC structures. */ +/* + * The following structure defines the implementation of the "color" Tcl + * object, which maps a string color name to a TkColor object. The + * ptr1 field of the Tcl_Obj points to a TkColor object. + */ -struct TkGCList { - /* Next item on list. */ - TkGCList *next; - /* The display for the GC. */ - Display *display; - /* The GC. */ - GC gc; - /* GCForeground or GCBackground. */ - unsigned long mask; +static Tcl_ObjType colorObjType = { + "color", /* name */ + FreeColorObjProc, /* freeIntRepProc */ + DupColorObjProc, /* dupIntRepProc */ + NULL, /* updateStringProc */ + NULL /* setFromAnyProc */ }; + +/* + *---------------------------------------------------------------------- + * + * Tk_AllocColorFromObj -- + * + * Given a Tcl_Obj *, map the value to a corresponding + * XColor structure based on the tkwin given. + * + * Results: + * The return value is a pointer to an XColor structure that + * indicates the red, blue, and green intensities for the color + * given by the string in objPtr, and also specifies a pixel value + * to use to draw in that color. If an error occurs, NULL is + * returned and an error message will be left in interp's result + * (unless interp is NULL). + * + * Side effects: + * The color is added to an internal database with a reference count. + * For each call to this procedure, there should eventually be a call + * to Tk_FreeColorFromObj so that the database is cleaned up when colors + * aren't in use anymore. + * + *---------------------------------------------------------------------- + */ -/* END CYGNUS LOCAL */ +XColor * +Tk_AllocColorFromObj(interp, tkwin, objPtr) + Tcl_Interp *interp; /* Used only for error reporting. If NULL, + * then no messages are provided. */ + Tk_Window tkwin; /* Window in which the color will be used.*/ + Tcl_Obj *objPtr; /* Object that describes the color; string + * value is a color name such as "red" or + * "#ff0000".*/ +{ + TkColor *tkColPtr; + + if (objPtr->typePtr != &colorObjType) { + InitColorObj(objPtr); + } + tkColPtr = (TkColor *) objPtr->internalRep.twoPtrValue.ptr1; + + /* + * If the object currently points to a TkColor, see if it's the + * one we want. If so, increment its reference count and return. + */ + + if (tkColPtr != NULL) { + if (tkColPtr->resourceRefCount == 0) { + /* + * This is a stale reference: it refers to a TkColor that's + * no longer in use. Clear the reference. + */ + + FreeColorObjProc(objPtr); + tkColPtr = NULL; + } else if ((Tk_Screen(tkwin) == tkColPtr->screen) + && (Tk_Colormap(tkwin) == tkColPtr->colormap)) { + tkColPtr->resourceRefCount++; + return (XColor *) tkColPtr; + } + } + + /* + * The object didn't point to the TkColor that we wanted. Search + * the list of TkColors with the same name to see if one of the + * other TkColors is the right one. + */ + + if (tkColPtr != NULL) { + TkColor *firstColorPtr = + (TkColor *) Tcl_GetHashValue(tkColPtr->hashPtr); + FreeColorObjProc(objPtr); + for (tkColPtr = firstColorPtr; tkColPtr != NULL; + tkColPtr = tkColPtr->nextPtr) { + if ((Tk_Screen(tkwin) == tkColPtr->screen) + && (Tk_Colormap(tkwin) == tkColPtr->colormap)) { + tkColPtr->resourceRefCount++; + tkColPtr->objRefCount++; + objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) tkColPtr; + return (XColor *) tkColPtr; + } + } + } + + /* + * Still no luck. Call Tk_GetColor to allocate a new TkColor object. + */ + + tkColPtr = (TkColor *) Tk_GetColor(interp, tkwin, Tcl_GetString(objPtr)); + objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) tkColPtr; + if (tkColPtr != NULL) { + tkColPtr->objRefCount++; + } + return (XColor *) tkColPtr; +} /* *---------------------------------------------------------------------- @@ -94,7 +171,7 @@ struct TkGCList { * indicates the red, blue, and green intensities for the color * given by "name", and also specifies a pixel value to use to * draw in that color. If an error occurs, NULL is returned and - * an error message will be left in interp->result. + * an error message will be left in the interp's result. * * Side effects: * The color is added to an internal database with a reference count. @@ -110,17 +187,17 @@ Tk_GetColor(interp, tkwin, name) Tcl_Interp *interp; /* Place to leave error message if * color can't be found. */ Tk_Window tkwin; /* Window in which color will be used. */ - Tk_Uid name; /* Name of color to allocated (in form + char *name; /* Name of color to be allocated (in form * suitable for passing to XParseColor). */ { - NameKey nameKey; Tcl_HashEntry *nameHashPtr; int new; TkColor *tkColPtr; - Display *display = Tk_Display(tkwin); + TkColor *existingColPtr; + TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; - if (!initialized) { - ColorInit(); + if (!dispPtr->colorInit) { + ColorInit(dispPtr); } /* @@ -128,14 +205,19 @@ Tk_GetColor(interp, tkwin, name) * name. */ - nameKey.name = name; - nameKey.colormap = Tk_Colormap(tkwin); - nameKey.display = display; - nameHashPtr = Tcl_CreateHashEntry(&nameTable, (char *) &nameKey, &new); + nameHashPtr = Tcl_CreateHashEntry(&dispPtr->colorNameTable, name, &new); if (!new) { - tkColPtr = (TkColor *) Tcl_GetHashValue(nameHashPtr); - tkColPtr->refCount++; - return &tkColPtr->color; + existingColPtr = (TkColor *) Tcl_GetHashValue(nameHashPtr); + for (tkColPtr = existingColPtr; tkColPtr != NULL; + tkColPtr = tkColPtr->nextPtr) { + if ((tkColPtr->screen == Tk_Screen(tkwin)) + && (Tk_Colormap(tkwin) == tkColPtr->colormap)) { + tkColPtr->resourceRefCount++; + return &tkColPtr->color; + } + } + } else { + existingColPtr = NULL; } /* @@ -154,22 +236,27 @@ Tk_GetColor(interp, tkwin, name) "\"", (char *) NULL); } } - Tcl_DeleteHashEntry(nameHashPtr); + if (new) { + Tcl_DeleteHashEntry(nameHashPtr); + } return (XColor *) NULL; } /* - * Now create a new TkColor structure and add it to nameTable. + * Now create a new TkColor structure and add it to colorNameTable + * (in TkDisplay). */ tkColPtr->magic = COLOR_MAGIC; tkColPtr->gc = None; tkColPtr->screen = Tk_Screen(tkwin); - tkColPtr->colormap = nameKey.colormap; + tkColPtr->colormap = Tk_Colormap(tkwin); tkColPtr->visual = Tk_Visual(tkwin); - tkColPtr->refCount = 1; - tkColPtr->tablePtr = &nameTable; + tkColPtr->resourceRefCount = 1; + tkColPtr->objRefCount = 0; + tkColPtr->type = TK_COLOR_BY_NAME; tkColPtr->hashPtr = nameHashPtr; + tkColPtr->nextPtr = existingColPtr; tkColPtr->gcList = NULL; Tcl_SetHashValue(nameHashPtr, tkColPtr); @@ -211,9 +298,10 @@ Tk_GetColorByValue(tkwin, colorPtr) int new; TkColor *tkColPtr; Display *display = Tk_Display(tkwin); + TkDisplay *dispPtr = TkGetDisplay(display); - if (!initialized) { - ColorInit(); + if (!dispPtr->colorInit) { + ColorInit(dispPtr); } /* @@ -226,16 +314,17 @@ Tk_GetColorByValue(tkwin, colorPtr) valueKey.blue = colorPtr->blue; valueKey.colormap = Tk_Colormap(tkwin); valueKey.display = display; - valueHashPtr = Tcl_CreateHashEntry(&valueTable, (char *) &valueKey, &new); + valueHashPtr = Tcl_CreateHashEntry(&dispPtr->colorValueTable, + (char *) &valueKey, &new); if (!new) { tkColPtr = (TkColor *) Tcl_GetHashValue(valueHashPtr); - tkColPtr->refCount++; + tkColPtr->resourceRefCount++; return &tkColPtr->color; } /* * The name isn't currently known. Find a pixel value for this - * color and add a new structure to valueTable. + * color and add a new structure to colorValueTable (in TkDisplay). */ tkColPtr = TkpGetColorByValue(tkwin, colorPtr); @@ -244,9 +333,11 @@ Tk_GetColorByValue(tkwin, colorPtr) tkColPtr->screen = Tk_Screen(tkwin); tkColPtr->colormap = valueKey.colormap; tkColPtr->visual = Tk_Visual(tkwin); - tkColPtr->refCount = 1; - tkColPtr->tablePtr = &valueTable; + tkColPtr->resourceRefCount = 1; + tkColPtr->objRefCount = 0; + tkColPtr->type = TK_COLOR_BY_VALUE; tkColPtr->hashPtr = valueHashPtr; + tkColPtr->nextPtr = NULL; tkColPtr->gcList = NULL; Tcl_SetHashValue(valueHashPtr, tkColPtr); return &tkColPtr->color; @@ -279,15 +370,17 @@ Tk_NameOfColor(colorPtr) XColor *colorPtr; /* Color whose name is desired. */ { register TkColor *tkColPtr = (TkColor *) colorPtr; - static char string[20]; - - if ((tkColPtr->magic == COLOR_MAGIC) - && (tkColPtr->tablePtr == &nameTable)) { - return ((NameKey *) tkColPtr->hashPtr->key.words)->name; + + if ((tkColPtr->magic == COLOR_MAGIC) && + (tkColPtr->type == TK_COLOR_BY_NAME)) { + return tkColPtr->hashPtr->key.string; + } else { + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + sprintf(tsdPtr->rgbString, "#%04x%04x%04x", colorPtr->red, + colorPtr->green, colorPtr->blue); + return tsdPtr->rgbString; } - sprintf(string, "#%04x%04x%04x", colorPtr->red, colorPtr->green, - colorPtr->blue); - return string; } /* @@ -314,8 +407,7 @@ Tk_NameOfColor(colorPtr) GC Tk_GCForColor(colorPtr, drawable) XColor *colorPtr; /* Color for which a GC is desired. Must - * have been allocated by Tk_GetColor or - * Tk_GetColorByName. */ + * have been allocated by Tk_GetColor. */ Drawable drawable; /* Drawable in which the color will be * used (must have same screen and depth * as the one for which the color was @@ -366,8 +458,9 @@ Tk_FreeColor(colorPtr) * allocated by Tk_GetColor or * Tk_GetColorByValue. */ { - register TkColor *tkColPtr = (TkColor *) colorPtr; + TkColor *tkColPtr = (TkColor *) colorPtr; Screen *screen = tkColPtr->screen; + TkColor *prevPtr; /* * Do a quick sanity check to make sure this color was really @@ -378,15 +471,45 @@ Tk_FreeColor(colorPtr) panic("Tk_FreeColor called with bogus color"); } - tkColPtr->refCount--; - if (tkColPtr->refCount == 0) { - if (tkColPtr->gc != None) { - XFreeGC(DisplayOfScreen(screen), tkColPtr->gc); - tkColPtr->gc = None; + tkColPtr->resourceRefCount--; + if (tkColPtr->resourceRefCount > 0) { + return; + } + + /* + * This color is no longer being actively used, so free the color + * resources associated with it and remove it from the hash table. + * no longer any objects referencing it. + */ + + if (tkColPtr->gc != None) { + XFreeGC(DisplayOfScreen(screen), tkColPtr->gc); + tkColPtr->gc = None; + } + TkpFreeColor(tkColPtr); + + prevPtr = (TkColor *) Tcl_GetHashValue(tkColPtr->hashPtr); + if (prevPtr == tkColPtr) { + if (tkColPtr->nextPtr == NULL) { + Tcl_DeleteHashEntry(tkColPtr->hashPtr); + } else { + Tcl_SetHashValue(tkColPtr->hashPtr, tkColPtr->nextPtr); + } + } else { + while (prevPtr->nextPtr != tkColPtr) { + prevPtr = prevPtr->nextPtr; } - TkpFreeColor(tkColPtr); - Tcl_DeleteHashEntry(tkColPtr->hashPtr); - tkColPtr->magic = 0; + prevPtr->nextPtr = tkColPtr->nextPtr; + } + + /* + * Free the TkColor structure if there are no objects referencing + * it. However, if there are objects referencing it then keep the + * structure around; it will get freed when the last reference is + * cleared + */ + + if (tkColPtr->objRefCount == 0) { ckfree((char *) tkColPtr); } } @@ -394,131 +517,300 @@ Tk_FreeColor(colorPtr) /* *---------------------------------------------------------------------- * - * ColorInit -- + * Tk_FreeColorFromObj -- * - * Initialize the structure used for color management. + * This procedure is called to release a color allocated by + * Tk_AllocColorFromObj. It does not throw away the Tcl_Obj *; + * it only gets rid of the hash table entry for this color + * and clears the cached value that is normally stored in the object. * * Results: * None. * * Side effects: - * Read the code. + * The reference count associated with the color represented by + * objPtr is decremented, and the color is released to X if there are + * no remaining uses for it. * *---------------------------------------------------------------------- */ -static void -ColorInit() +void +Tk_FreeColorFromObj(tkwin, objPtr) + Tk_Window tkwin; /* The window this color lives in. Needed + * for the screen and colormap values. */ + Tcl_Obj *objPtr; /* The Tcl_Obj * to be freed. */ { - initialized = 1; - Tcl_InitHashTable(&nameTable, sizeof(NameKey)/sizeof(int)); - Tcl_InitHashTable(&valueTable, sizeof(ValueKey)/sizeof(int)); + Tk_FreeColor(Tk_GetColorFromObj(tkwin, objPtr)); + FreeColorObjProc(objPtr); } -/* CYGNUS LOCAL: Call a function on every named color. This is used - on Windows to change the colors when the user changes them via the - control panel. */ +/* + *--------------------------------------------------------------------------- + * + * FreeColorObjProc -- + * + * This proc is called to release an object reference to a color. + * Called when the object's internal rep is released or when + * the cached tkColPtr needs to be changed. + * + * Results: + * None. + * + * Side effects: + * The object reference count is decremented. When both it + * and the hash ref count go to zero, the color's resources + * are released. + * + *--------------------------------------------------------------------------- + */ -void -TkMapOverColors(func) - void (*func) _ANSI_ARGS_((TkColor *)); +static void +FreeColorObjProc(objPtr) + Tcl_Obj *objPtr; /* The object we are releasing. */ { - Tcl_HashEntry *nameHashPtr; - Tcl_HashSearch search; - TkColor *tkColPtr; + TkColor *tkColPtr = (TkColor *) objPtr->internalRep.twoPtrValue.ptr1; - nameHashPtr = Tcl_FirstHashEntry(&nameTable, &search); - while (nameHashPtr != NULL) { - tkColPtr = (TkColor *) Tcl_GetHashValue(nameHashPtr); - (*func)(tkColPtr); - nameHashPtr = Tcl_NextHashEntry(&search); + if (tkColPtr != NULL) { + tkColPtr->objRefCount--; + if ((tkColPtr->objRefCount == 0) + && (tkColPtr->resourceRefCount == 0)) { + ckfree((char *) tkColPtr); + } + objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) NULL; } } + +/* + *--------------------------------------------------------------------------- + * + * DupColorObjProc -- + * + * When a cached color object is duplicated, this is called to + * update the internal reps. + * + * Results: + * None. + * + * Side effects: + * The color's objRefCount is incremented and the internal rep + * of the copy is set to point to it. + * + *--------------------------------------------------------------------------- + */ -/* CYGNUS LOCAL: For each color, we keep a list of GCs that use that - color as the foreground or background. This is so that we can - change them on Windows when the user changes the system colors. */ - -void -TkRegisterColorGC(colorPtr, display, gc, valueMask) - XColor *colorPtr; - Display *display; - GC gc; - unsigned long valueMask; +static void +DupColorObjProc(srcObjPtr, dupObjPtr) + Tcl_Obj *srcObjPtr; /* The object we are copying from. */ + Tcl_Obj *dupObjPtr; /* The object we are copying to. */ { - TkColor *tkColPtr = (TkColor *) colorPtr; - TkGCList *gcListPtr; + TkColor *tkColPtr = (TkColor *) srcObjPtr->internalRep.twoPtrValue.ptr1; + + dupObjPtr->typePtr = srcObjPtr->typePtr; + dupObjPtr->internalRep.twoPtrValue.ptr1 = (VOID *) tkColPtr; - if (tkColPtr->magic != COLOR_MAGIC) { - return; + if (tkColPtr != NULL) { + tkColPtr->objRefCount++; } - - gcListPtr = (TkGCList *) ckalloc(sizeof(TkGCList)); - gcListPtr->display = display; - gcListPtr->gc = gc; - gcListPtr->mask = valueMask; - gcListPtr->next = tkColPtr->gcList; - tkColPtr->gcList = gcListPtr; - - /* Each GC added to the list counts as a reference to the color, - so that we don't free the color before freeing the GC. */ - - tkColPtr->refCount++; } + +/* + *---------------------------------------------------------------------- + * + * Tk_GetColorFromObj -- + * + * Returns the color referred to by a Tcl object. The color must + * already have been allocated via a call to Tk_AllocColorFromObj + * or Tk_GetColor. + * + * Results: + * Returns the XColor * that matches the tkwin and the string rep + * of objPtr. + * + * Side effects: + * If the object is not already a color, the conversion will free + * any old internal representation. + * + *---------------------------------------------------------------------- + */ -/* This is called when a GC with a registered color is deleted. */ - -void -TkDeregisterColorGC(colorPtr, gc, valueMask) - XColor *colorPtr; - GC gc; - unsigned long valueMask; +XColor * +Tk_GetColorFromObj(tkwin, objPtr) + Tk_Window tkwin; /* The window in which the color will be + * used. */ + Tcl_Obj *objPtr; /* String value contains the name of the + * desired color. */ { - TkColor *tkColPtr = (TkColor *) colorPtr; - TkGCList **gcListPtrPtr, *gcListPtr; + TkColor *tkColPtr; + Tcl_HashEntry *hashPtr; + TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; - if (tkColPtr->magic != COLOR_MAGIC) { - return; + if (objPtr->typePtr != &colorObjType) { + InitColorObj(objPtr); + } + + /* + * First check to see if the internal representation of the object + * is defined and is a color that is valid for the current screen + * and color map. If it is, we are done. + */ + tkColPtr = (TkColor *) objPtr->internalRep.twoPtrValue.ptr1; + if ((tkColPtr != NULL) + && (tkColPtr->resourceRefCount > 0) + && (Tk_Screen(tkwin) == tkColPtr->screen) + && (Tk_Colormap(tkwin) == tkColPtr->colormap)) { + /* + * The object already points to the right TkColor structure. + * Just return it. + */ + + return (XColor *) tkColPtr; } - for (gcListPtrPtr = &tkColPtr->gcList; - *gcListPtrPtr != NULL; - gcListPtrPtr = &(*gcListPtrPtr)->next) { - if ((*gcListPtrPtr)->gc == gc && (*gcListPtrPtr)->mask == valueMask) { - gcListPtr = *gcListPtrPtr; - *gcListPtrPtr = gcListPtr->next; - ckfree((char *) gcListPtr); - Tk_FreeColor((XColor *) tkColPtr); - break; + /* + * If we reach this point, it means that the TkColor structure + * that we have cached in the internal representation is not valid + * for the current screen and colormap. But there is a list of + * other TkColor structures attached to the TkDisplay. Walk this + * list looking for the right TkColor structure. + */ + + hashPtr = Tcl_FindHashEntry(&dispPtr->colorNameTable, + Tcl_GetString(objPtr)); + if (hashPtr == NULL) { + goto error; + } + for (tkColPtr = (TkColor *) Tcl_GetHashValue(hashPtr); + (tkColPtr != NULL); tkColPtr = tkColPtr->nextPtr) { + if ((Tk_Screen(tkwin) == tkColPtr->screen) + && (Tk_Colormap(tkwin) == tkColPtr->colormap)) { + FreeColorObjProc(objPtr); + objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) tkColPtr; + tkColPtr->objRefCount++; + return (XColor *) tkColPtr; } } -} -/* This is called when a color is changed by the user on Windows. */ + error: + panic(" Tk_GetColorFromObj called with non-existent color!"); + /* + * The following code isn't reached; it's just there to please compilers. + */ + return NULL; +} + +/* + *---------------------------------------------------------------------- + * + * InitColorObj -- + * + * Bookeeping procedure to change an objPtr to a color type. + * + * Results: + * None. + * + * Side effects: + * The old internal rep of the object is freed. The object's + * type is set to color with a NULL TkColor pointer (the pointer + * will be set later by either Tk_AllocColorFromObj or + * Tk_GetColorFromObj). + * + *---------------------------------------------------------------------- + */ -void -TkColorChanged(tkColPtr) - TkColor *tkColPtr; +static void +InitColorObj(objPtr) + Tcl_Obj *objPtr; /* The object to convert. */ { - TkGCList *gcListPtr; - XGCValues gcValues; + Tcl_ObjType *typePtr; - for (gcListPtr = tkColPtr->gcList; - gcListPtr != NULL; - gcListPtr = gcListPtr->next) { - if (gcListPtr->mask == GCForeground) { - gcValues.foreground = tkColPtr->color.pixel; - } else { - gcValues.background = tkColPtr->color.pixel; - } + /* + * Free the old internalRep before setting the new one. + */ - XChangeGC(gcListPtr->display, gcListPtr->gc, gcListPtr->mask, - &gcValues); + Tcl_GetString(objPtr); + typePtr = objPtr->typePtr; + if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) { + (*typePtr->freeIntRepProc)(objPtr); } + objPtr->typePtr = &colorObjType; + objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) NULL; +} + +/* + *---------------------------------------------------------------------- + * + * ColorInit -- + * + * Initialize the structure used for color management. + * + * Results: + * None. + * + * Side effects: + * Read the code. + * + *---------------------------------------------------------------------- + */ - if (tkColPtr->gc != None) { - gcValues.foreground = tkColPtr->color.pixel; - XChangeGC(DisplayOfScreen(tkColPtr->screen), tkColPtr->gc, - GCForeground, &gcValues); +static void +ColorInit(dispPtr) + TkDisplay *dispPtr; +{ + if (!dispPtr->colorInit) { + dispPtr->colorInit = 1; + Tcl_InitHashTable(&dispPtr->colorNameTable, TCL_STRING_KEYS); + Tcl_InitHashTable(&dispPtr->colorValueTable, + sizeof(ValueKey)/sizeof(int)); + } +} + +/* + *---------------------------------------------------------------------- + * + * TkDebugColor -- + * + * This procedure returns debugging information about a color. + * + * Results: + * The return value is a list with one sublist for each TkColor + * corresponding to "name". Each sublist has two elements that + * contain the resourceRefCount and objRefCount fields from the + * TkColor structure. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +Tcl_Obj * +TkDebugColor(tkwin, name) + Tk_Window tkwin; /* The window in which the color will be + * used (not currently used). */ + char *name; /* Name of the desired color. */ +{ + TkColor *tkColPtr; + Tcl_HashEntry *hashPtr; + Tcl_Obj *resultPtr, *objPtr; + TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; + + resultPtr = Tcl_NewObj(); + hashPtr = Tcl_FindHashEntry(&dispPtr->colorNameTable, name); + if (hashPtr != NULL) { + tkColPtr = (TkColor *) Tcl_GetHashValue(hashPtr); + if (tkColPtr == NULL) { + panic("TkDebugColor found empty hash table entry"); + } + for ( ; (tkColPtr != NULL); tkColPtr = tkColPtr->nextPtr) { + objPtr = Tcl_NewObj(); + Tcl_ListObjAppendElement(NULL, objPtr, + Tcl_NewIntObj(tkColPtr->resourceRefCount)); + Tcl_ListObjAppendElement(NULL, objPtr, + Tcl_NewIntObj(tkColPtr->objRefCount)); + Tcl_ListObjAppendElement(NULL, resultPtr, objPtr); + } } + return resultPtr; } + |