util/src/TclTk/tk8.6.12/generic/ttk/ttkCache.c

   1 /*
   2  *      Theme engine resource cache.
   3  *
   4  * Copyright (c) 2004, Joe English
   5  *
   6  * The problem:
   7  *
   8  * Tk maintains reference counts for fonts, colors, and images,
   9  * and deallocates them when the reference count goes to zero.
  10  * With the theme engine, resources are allocated right before
  11  * drawing an element and released immediately after.
  12  * This causes a severe performance penalty, and on PseudoColor
  13  * visuals it causes colormap cycling as colormap entries are
  14  * released and reused.
  15  *
  16  * Solution: Acquire fonts, colors, and objects from a
  17  * resource cache instead of directly from Tk; the cache
  18  * holds a semipermanent reference to the resource to keep
  19  * it from being deallocated.
  20  *
  21  * The plumbing and control flow here is quite contorted;
  22  * it would be better to address this problem in the core instead.
  23  *
  24  * @@@ BUGS/TODO: Need distinct caches for each combination
  25  * of display, visual, and colormap.
  26  *
  27  * @@@ Colormap flashing on PseudoColor visuals is still possible,
  28  * but this will be a transient effect.
  29  */
  30
  31 #include "tkInt.h"
  32 #include "ttkTheme.h"
  33
  34 struct Ttk_ResourceCache_ {
  35     Tcl_Interp    *interp;      /* Interpreter for error reporting */
  36     Tk_Window     tkwin;        /* Cache window. */
  37     Tcl_HashTable fontTable;    /* Entries: Tcl_Obj* holding FontObjs */
  38     Tcl_HashTable colorTable;   /* Entries: Tcl_Obj* holding ColorObjs */
  39     Tcl_HashTable borderTable;  /* Entries: Tcl_Obj* holding BorderObjs */
  40     Tcl_HashTable imageTable;   /* Entries: Tk_Images */
  41
  42     Tcl_HashTable namedColors;  /* Entries: RGB values as Tcl_StringObjs */
  43 };
  44
  45 /*
  46  * Ttk_CreateResourceCache --
  47  *      Initialize a new resource cache.
  48  */
  49 Ttk_ResourceCache Ttk_CreateResourceCache(Tcl_Interp *interp)
  50 {
  51     Ttk_ResourceCache cache = ckalloc(sizeof(*cache));
  52
  53     cache->tkwin = NULL;        /* initialized later */
  54     cache->interp = interp;
  55     Tcl_InitHashTable(&cache->fontTable, TCL_STRING_KEYS);
  56     Tcl_InitHashTable(&cache->colorTable, TCL_STRING_KEYS);
  57     Tcl_InitHashTable(&cache->borderTable, TCL_STRING_KEYS);
  58     Tcl_InitHashTable(&cache->imageTable, TCL_STRING_KEYS);
  59     Tcl_InitHashTable(&cache->namedColors, TCL_STRING_KEYS);
  60
  61     return cache;
  62 }
  63
  64 /*
  65  * Ttk_ClearCache --
  66  *      Release references to all cached resources.
  67  */
  68 static void Ttk_ClearCache(Ttk_ResourceCache cache)
  69 {
  70     Tcl_HashSearch search;
  71     Tcl_HashEntry *entryPtr;
  72
  73     /*
  74      * Free fonts:
  75      */
  76     entryPtr = Tcl_FirstHashEntry(&cache->fontTable, &search);
  77     while (entryPtr != NULL) {
  78         Tcl_Obj *fontObj = Tcl_GetHashValue(entryPtr);
  79         if (fontObj) {
  80             Tk_FreeFontFromObj(cache->tkwin, fontObj);
  81             Tcl_DecrRefCount(fontObj);
  82         }
  83         entryPtr = Tcl_NextHashEntry(&search);
  84     }
  85     Tcl_DeleteHashTable(&cache->fontTable);
  86     Tcl_InitHashTable(&cache->fontTable, TCL_STRING_KEYS);
  87
  88     /*
  89      * Free colors:
  90      */
  91     entryPtr = Tcl_FirstHashEntry(&cache->colorTable, &search);
  92     while (entryPtr != NULL) {
  93         Tcl_Obj *colorObj = Tcl_GetHashValue(entryPtr);
  94         if (colorObj) {
  95             Tk_FreeColorFromObj(cache->tkwin, colorObj);
  96             Tcl_DecrRefCount(colorObj);
  97         }
  98         entryPtr = Tcl_NextHashEntry(&search);
  99     }
 100     Tcl_DeleteHashTable(&cache->colorTable);
 101     Tcl_InitHashTable(&cache->colorTable, TCL_STRING_KEYS);
 102
 103     /*
 104      * Free borders:
 105      */
 106     entryPtr = Tcl_FirstHashEntry(&cache->borderTable, &search);
 107     while (entryPtr != NULL) {
 108         Tcl_Obj *borderObj = Tcl_GetHashValue(entryPtr);
 109         if (borderObj) {
 110             Tk_Free3DBorderFromObj(cache->tkwin, borderObj);
 111             Tcl_DecrRefCount(borderObj);
 112         }
 113         entryPtr = Tcl_NextHashEntry(&search);
 114     }
 115     Tcl_DeleteHashTable(&cache->borderTable);
 116     Tcl_InitHashTable(&cache->borderTable, TCL_STRING_KEYS);
 117
 118     /*
 119      * Free images:
 120      */
 121     entryPtr = Tcl_FirstHashEntry(&cache->imageTable, &search);
 122     while (entryPtr != NULL) {
 123         Tk_Image image = Tcl_GetHashValue(entryPtr);
 124         if (image) {
 125             Tk_FreeImage(image);
 126         }
 127         entryPtr = Tcl_NextHashEntry(&search);
 128     }
 129     Tcl_DeleteHashTable(&cache->imageTable);
 130     Tcl_InitHashTable(&cache->imageTable, TCL_STRING_KEYS);
 131
 132     return;
 133 }
 134
 135 /*
 136  * Ttk_FreeResourceCache --
 137  *      Release references to all cached resources, delete the cache.
 138  */
 139
 140 void Ttk_FreeResourceCache(Ttk_ResourceCache cache)
 141 {
 142     Tcl_HashEntry *entryPtr;
 143     Tcl_HashSearch search;
 144
 145     Ttk_ClearCache(cache);
 146
 147     Tcl_DeleteHashTable(&cache->colorTable);
 148     Tcl_DeleteHashTable(&cache->fontTable);
 149     Tcl_DeleteHashTable(&cache->imageTable);
 150
 151     /*
 152      * Free named colors:
 153      */
 154     entryPtr = Tcl_FirstHashEntry(&cache->namedColors, &search);
 155     while (entryPtr != NULL) {
 156         Tcl_Obj *colorNameObj = Tcl_GetHashValue(entryPtr);
 157         Tcl_DecrRefCount(colorNameObj);
 158         entryPtr = Tcl_NextHashEntry(&search);
 159     }
 160     Tcl_DeleteHashTable(&cache->namedColors);
 161
 162     ckfree(cache);
 163 }
 164
 165 /*
 166  * CacheWinEventHandler --
 167  *      Detect when the cache window is destroyed, clear cache.
 168  */
 169 static void CacheWinEventHandler(ClientData clientData, XEvent *eventPtr)
 170 {
 171     Ttk_ResourceCache cache = clientData;
 172
 173     if (eventPtr->type != DestroyNotify) {
 174         return;
 175     }
 176     Tk_DeleteEventHandler(cache->tkwin, StructureNotifyMask,
 177             CacheWinEventHandler, clientData);
 178     Ttk_ClearCache(cache);
 179     cache->tkwin = NULL;
 180 }
 181
 182 /*
 183  * InitCacheWindow --
 184  *      Specify the cache window if not already set.
 185  *      @@@ SHOULD: use separate caches for each combination
 186  *      @@@ of display, visual, and colormap.
 187  */
 188 static void InitCacheWindow(Ttk_ResourceCache cache, Tk_Window tkwin)
 189 {
 190     if (cache->tkwin == NULL) {
 191         cache->tkwin = tkwin;
 192         Tk_CreateEventHandler(tkwin, StructureNotifyMask,
 193                 CacheWinEventHandler, cache);
 194     }
 195 }
 196
 197 /*
 198  * Ttk_RegisterNamedColor --
 199  *      Specify an RGB triplet as a named color.
 200  *      Overrides any previous named color specification.
 201  */
 202 void Ttk_RegisterNamedColor(
 203     Ttk_ResourceCache cache,
 204     const char *colorName,
 205     XColor *colorPtr)
 206 {
 207     int newEntry;
 208     Tcl_HashEntry *entryPtr;
 209     char nameBuf[14];
 210     Tcl_Obj *colorNameObj;
 211
 212     sprintf(nameBuf, "#%04X%04X%04X",
 213         colorPtr->red, colorPtr->green, colorPtr->blue);
 214     colorNameObj = Tcl_NewStringObj(nameBuf, -1);
 215     Tcl_IncrRefCount(colorNameObj);
 216
 217     entryPtr = Tcl_CreateHashEntry(&cache->namedColors, colorName, &newEntry);
 218     if (!newEntry) {
 219         Tcl_Obj *oldColor = Tcl_GetHashValue(entryPtr);
 220         Tcl_DecrRefCount(oldColor);
 221     }
 222
 223     Tcl_SetHashValue(entryPtr, colorNameObj);
 224 }
 225
 226 /*
 227  * CheckNamedColor(objPtr) --
 228  *      If objPtr is a registered color name, return a Tcl_Obj *
 229  *      containing the registered color value specification.
 230  *      Otherwise, return the input argument.
 231  */
 232 static Tcl_Obj *CheckNamedColor(Ttk_ResourceCache cache, Tcl_Obj *objPtr)
 233 {
 234     Tcl_HashEntry *entryPtr =
 235         Tcl_FindHashEntry(&cache->namedColors, Tcl_GetString(objPtr));
 236     if (entryPtr) {     /* Use named color instead */
 237         objPtr = Tcl_GetHashValue(entryPtr);
 238     }
 239     return objPtr;
 240 }
 241
 242 /*
 243  * Template for allocation routines:
 244  */
 245 typedef void *(*Allocator)(Tcl_Interp *, Tk_Window, Tcl_Obj *);
 246
 247 static Tcl_Obj *Ttk_Use(
 248     Tcl_Interp *interp,
 249     Tcl_HashTable *table,
 250     Allocator allocate,
 251     Tk_Window tkwin,
 252     Tcl_Obj *objPtr)
 253 {
 254     int newEntry;
 255     Tcl_HashEntry *entryPtr =
 256         Tcl_CreateHashEntry(table,Tcl_GetString(objPtr),&newEntry);
 257     Tcl_Obj *cacheObj;
 258
 259     if (!newEntry) {
 260         return Tcl_GetHashValue(entryPtr);
 261     }
 262
 263     cacheObj = Tcl_DuplicateObj(objPtr);
 264     Tcl_IncrRefCount(cacheObj);
 265
 266     if (allocate(interp, tkwin, cacheObj)) {
 267         Tcl_SetHashValue(entryPtr, cacheObj);
 268         return cacheObj;
 269     } else {
 270         Tcl_DecrRefCount(cacheObj);
 271         Tcl_SetHashValue(entryPtr, NULL);
 272         Tcl_BackgroundException(interp, TCL_ERROR);
 273         return NULL;
 274     }
 275 }
 276
 277 /*
 278  * Ttk_UseFont --
 279  *      Acquire a font from the cache.
 280  */
 281 Tcl_Obj *Ttk_UseFont(Ttk_ResourceCache cache, Tk_Window tkwin, Tcl_Obj *objPtr)
 282 {
 283     InitCacheWindow(cache, tkwin);
 284     return Ttk_Use(cache->interp,
 285         &cache->fontTable,(Allocator)Tk_AllocFontFromObj, tkwin, objPtr);
 286 }
 287
 288 /*
 289  * Ttk_UseColor --
 290  *      Acquire a color from the cache.
 291  */
 292 Tcl_Obj *Ttk_UseColor(Ttk_ResourceCache cache, Tk_Window tkwin, Tcl_Obj *objPtr)
 293 {
 294     objPtr = CheckNamedColor(cache, objPtr);
 295     InitCacheWindow(cache, tkwin);
 296     return Ttk_Use(cache->interp,
 297         &cache->colorTable,(Allocator)Tk_AllocColorFromObj, tkwin, objPtr);
 298 }
 299
 300 /*
 301  * Ttk_UseBorder --
 302  *      Acquire a Tk_3DBorder from the cache.
 303  */
 304 Tcl_Obj *Ttk_UseBorder(
 305     Ttk_ResourceCache cache, Tk_Window tkwin, Tcl_Obj *objPtr)
 306 {
 307     objPtr = CheckNamedColor(cache, objPtr);
 308     InitCacheWindow(cache, tkwin);
 309     return Ttk_Use(cache->interp,
 310         &cache->borderTable,(Allocator)Tk_Alloc3DBorderFromObj, tkwin, objPtr);
 311 }
 312
 313 /* NullImageChanged --
 314  *      Tk_ImageChangedProc for Ttk_UseImage
 315  */
 316
 317 static void NullImageChanged(ClientData clientData,
 318     int x, int y, int width, int height, int imageWidth, int imageHeight)
 319 { /* No-op */ }
 320
 321 /*
 322  * Ttk_UseImage --
 323  *      Acquire a Tk_Image from the cache.
 324  */
 325 Tk_Image Ttk_UseImage(Ttk_ResourceCache cache, Tk_Window tkwin, Tcl_Obj *objPtr)
 326 {
 327     const char *imageName = Tcl_GetString(objPtr);
 328     int newEntry;
 329     Tcl_HashEntry *entryPtr =
 330         Tcl_CreateHashEntry(&cache->imageTable,imageName,&newEntry);
 331     Tk_Image image;
 332
 333     InitCacheWindow(cache, tkwin);
 334
 335     if (!newEntry) {
 336         return Tcl_GetHashValue(entryPtr);
 337     }
 338
 339     image = Tk_GetImage(cache->interp, tkwin, imageName, NullImageChanged,0);
 340     Tcl_SetHashValue(entryPtr, image);
 341
 342     if (!image) {
 343         Tcl_BackgroundException(cache->interp, TCL_ERROR);
 344     }
 345
 346     return image;
 347 }
 348
 349 /*EOF*/