1 /*
2 * Theme engine resource cache.
3 *
4 * Copyright © 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 */
Ttk_CreateResourceCache(Tcl_Interp * interp)49 Ttk_ResourceCache Ttk_CreateResourceCache(Tcl_Interp *interp)
50 {
51 Ttk_ResourceCache cache = (Ttk_ResourceCache)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 */
Ttk_ClearCache(Ttk_ResourceCache cache)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_Obj *)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_Obj *)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_Obj *)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 = (Tk_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
Ttk_FreeResourceCache(Ttk_ResourceCache cache)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_Obj *)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 */
CacheWinEventHandler(ClientData clientData,XEvent * eventPtr)169 static void CacheWinEventHandler(ClientData clientData, XEvent *eventPtr)
170 {
171 Ttk_ResourceCache cache = (Ttk_ResourceCache)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 */
InitCacheWindow(Ttk_ResourceCache cache,Tk_Window tkwin)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 */
Ttk_RegisterNamedColor(Ttk_ResourceCache cache,const char * colorName,XColor * colorPtr)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_Obj *)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 */
CheckNamedColor(Ttk_ResourceCache cache,Tcl_Obj * objPtr)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_Obj *)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
Ttk_Use(Tcl_Interp * interp,Tcl_HashTable * table,Allocator allocate,Tk_Window tkwin,Tcl_Obj * objPtr)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_Obj *)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 */
Ttk_UseFont(Ttk_ResourceCache cache,Tk_Window tkwin,Tcl_Obj * objPtr)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 */
Ttk_UseColor(Ttk_ResourceCache cache,Tk_Window tkwin,Tcl_Obj * objPtr)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 */
Ttk_UseBorder(Ttk_ResourceCache cache,Tk_Window tkwin,Tcl_Obj * objPtr)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
NullImageChanged(ClientData dummy,int x,int y,int width,int height,int imageWidth,int imageHeight)317 static void NullImageChanged(ClientData dummy,
318 int x, int y, int width, int height, int imageWidth, int imageHeight)
319 { /* No-op */
320 (void)dummy;
321 (void)x;
322 (void)y;
323 (void)width;
324 (void)height;
325 (void)imageWidth;
326 (void)imageHeight;
327 }
328
329 /*
330 * Ttk_UseImage --
331 * Acquire a Tk_Image from the cache.
332 */
Ttk_UseImage(Ttk_ResourceCache cache,Tk_Window tkwin,Tcl_Obj * objPtr)333 Tk_Image Ttk_UseImage(Ttk_ResourceCache cache, Tk_Window tkwin, Tcl_Obj *objPtr)
334 {
335 const char *imageName = Tcl_GetString(objPtr);
336 int newEntry;
337 Tcl_HashEntry *entryPtr =
338 Tcl_CreateHashEntry(&cache->imageTable,imageName,&newEntry);
339 Tk_Image image;
340
341 InitCacheWindow(cache, tkwin);
342
343 if (!newEntry) {
344 return (Tk_Image)Tcl_GetHashValue(entryPtr);
345 }
346
347 image = Tk_GetImage(cache->interp, tkwin, imageName, NullImageChanged,0);
348 Tcl_SetHashValue(entryPtr, image);
349
350 if (!image) {
351 Tcl_BackgroundException(cache->interp, TCL_ERROR);
352 }
353
354 return image;
355 }
356
357 /*EOF*/
358