1/*
2 * tkStyle.c --
3 *
4 *	This file implements the widget styles and themes support.
5 *
6 * Copyright (c) 1990-1993 The Regents of the University of California.
7 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
8 *
9 * See the file "license.terms" for information on usage and redistribution
10 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
11 *
12 * RCS: @(#) $Id: tkStyle.c,v 1.3 2002/08/05 04:30:40 dgp Exp $
13 */
14
15#include "tkInt.h"
16
17/*
18 * The following structure is used to cache widget option specs matching an
19 * element's required options defined by Tk_ElementOptionSpecs. It also holds
20 * information behind Tk_StyledElement opaque tokens.
21 */
22
23typedef struct StyledWidgetSpec {
24    struct StyledElement *elementPtr;	/* Pointer to the element holding this
25					 * structure. */
26    Tk_OptionTable optionTable;		/* Option table for the widget class
27					 * using the element. */
28    CONST Tk_OptionSpec **optionsPtr;	/* Table of option spec pointers,
29					 * matching the option list provided
30					 * during element registration.
31					 * Malloc'd. */
32} StyledWidgetSpec;
33
34/*
35 * Elements are declared using static templates. But static
36 * information must be completed by dynamic information only
37 * accessible at runtime. For each registered element, an instance of
38 * the following structure is stored in each style engine and used to
39 * cache information about the widget types (identified by their
40 * optionTable) that use the given element.
41 */
42
43typedef struct StyledElement {
44    struct Tk_ElementSpec *specPtr;
45				/* Filled with template provided during
46				 * registration. NULL means no implementation
47				 * is available for the current engine. */
48    int nbWidgetSpecs;		/* Size of the array below. Number of distinct
49				 * widget classes (actually, distinct option
50				 * tables) that used the element so far. */
51    StyledWidgetSpec *widgetSpecs;
52				/* See above for the structure definition.
53				 * Table grows dynamically as new widgets
54				 * use the element. Malloc'd. */
55} StyledElement;
56
57/*
58 * The following structure holds information behind Tk_StyleEngine opaque
59 * tokens.
60 */
61
62typedef struct StyleEngine {
63    CONST char *name;		/* Name of engine. Points to a hash key. */
64    StyledElement *elements;	/* Table of widget element descriptors. Each
65				 * element is indexed by a unique system-wide
66				 * ID. Table grows dynamically as new elements
67				 * are registered. Malloc'd*/
68    struct StyleEngine *parentPtr;
69				/* Parent engine. Engines may be layered to form
70				 * a fallback chain, terminated by the default
71				 * system engine. */
72} StyleEngine;
73
74/*
75 * Styles are instances of style engines. The following structure holds
76 * information behind Tk_Style opaque tokens.
77 */
78
79typedef struct Style {
80    int refCount;		/* Number of active uses of this style.
81				 * If this count is 0, then this Style
82				 * structure is no longer valid. */
83    Tcl_HashEntry *hashPtr;	/* Entry in style table for this structure,
84				 * used when deleting it. */
85    CONST char *name;		/* Name of style. Points to a hash key. */
86    StyleEngine *enginePtr;	/* Style engine of which the style is an
87				 * instance. */
88    ClientData clientData;	/* Data provided during registration. */
89} Style;
90
91/*
92 * Each registered element uses an instance of the following structure.
93 */
94
95typedef struct Element {
96    CONST char *name;		/* Name of element. Points to a hash key. */
97    int id;			/* Id of element. */
98    int genericId;		/* Id of generic element. */
99    int created;		/* Boolean, whether the element was created
100				 * explicitly (was registered) or implicitly
101				 * (by a derived element). */
102} Element;
103
104/*
105 * Thread-local data.
106 */
107
108typedef struct ThreadSpecificData {
109    int nbInit;			/* Number of calls to the init proc. */
110    Tcl_HashTable engineTable;	/* Map a name to a style engine. Keys are
111				 * strings, values are Tk_StyleEngine
112				 * pointers. */
113    StyleEngine *defaultEnginePtr;
114				/* Default, core-defined style engine. Global
115				 * fallback for all engines. */
116    Tcl_HashTable styleTable;	/* Map a name to a style. Keys are strings,
117				 * values are Tk_Style pointers.*/
118    int nbElements;		/* Size of the below tables. */
119    Tcl_HashTable elementTable;	/* Map a name to an element Id. Keys are
120				 * strings, values are integer element IDs. */
121    Element *elements;		/* Array of Elements. */
122} ThreadSpecificData;
123
124static Tcl_ThreadDataKey dataKey;
125
126/*
127 * Forward declarations for procedures defined later in this file:
128 */
129
130/* TODO: sort alpha. */
131static int		CreateElement _ANSI_ARGS_((CONST char *name,
132			    int create));
133static void		DupStyleObjProc _ANSI_ARGS_((Tcl_Obj *srcObjPtr,
134			    Tcl_Obj *dupObjPtr));
135static void		FreeElement _ANSI_ARGS_((Element *elementPtr));
136static void		FreeStyle _ANSI_ARGS_((Style *stylePtr));
137static void		FreeStyledElement _ANSI_ARGS_((
138			    StyledElement *elementPtr));
139static void		FreeStyleEngine _ANSI_ARGS_((
140			    StyleEngine *enginePtr));
141static void		FreeStyleObjProc _ANSI_ARGS_((Tcl_Obj *objPtr));
142static void		FreeWidgetSpec _ANSI_ARGS_((
143			    StyledWidgetSpec *widgetSpecPtr));
144static StyledElement *	GetStyledElement _ANSI_ARGS_((
145			    StyleEngine *enginePtr, int elementId));
146static StyledWidgetSpec * GetWidgetSpec _ANSI_ARGS_((StyledElement *elementPtr,
147			    Tk_OptionTable optionTable));
148static void		InitElement _ANSI_ARGS_((Element *elementPtr,
149			    CONST char *name, int id, int genericId,
150			    int created));
151static void		InitStyle _ANSI_ARGS_((Style *stylePtr,
152			    Tcl_HashEntry *hashPtr, CONST char *name,
153			    StyleEngine *enginePtr, ClientData clientData));
154static void		InitStyledElement _ANSI_ARGS_((
155			    StyledElement *elementPtr));
156static void		InitStyleEngine _ANSI_ARGS_((StyleEngine *enginePtr,
157			    CONST char *name, StyleEngine *parentPtr));
158static void		InitWidgetSpec _ANSI_ARGS_((
159			    StyledWidgetSpec *widgetSpecPtr,
160			    StyledElement *elementPtr,
161			    Tk_OptionTable optionTable));
162static int		SetStyleFromAny _ANSI_ARGS_((Tcl_Interp *interp,
163			    Tcl_Obj *objPtr));
164
165/*
166 * The following structure defines the implementation of the "style" Tcl
167 * object, used for drawing. The internalRep.otherValuePtr field of
168 * each style object points to the Style structure for the stylefont, or
169 * NULL.
170 */
171
172static Tcl_ObjType styleObjType = {
173    "style",			/* name */
174    FreeStyleObjProc,		/* freeIntRepProc */
175    DupStyleObjProc,		/* dupIntRepProc */
176    NULL,			/* updateStringProc */
177    SetStyleFromAny		/* setFromAnyProc */
178};
179
180/*
181 *---------------------------------------------------------------------------
182 *
183 * TkStylePkgInit --
184 *
185 *	This procedure is called when an application is created.  It
186 *	initializes all the structures that are used by the style
187 *	package on a per application basis.
188 *
189 * Results:
190 *	Stores data in thread-local storage.
191 *
192 * Side effects:
193 *	Memory allocated.
194 *
195 *---------------------------------------------------------------------------
196 */
197
198void
199TkStylePkgInit(mainPtr)
200    TkMainInfo *mainPtr;	/* The application being created. */
201{
202    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
203            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
204
205    if (tsdPtr->nbInit != 0) return;
206
207    /*
208     * Initialize tables.
209     */
210
211    Tcl_InitHashTable(&tsdPtr->engineTable, TCL_STRING_KEYS);
212    Tcl_InitHashTable(&tsdPtr->styleTable, TCL_STRING_KEYS);
213    Tcl_InitHashTable(&tsdPtr->elementTable, TCL_STRING_KEYS);
214    tsdPtr->nbElements = 0;
215    tsdPtr->elements = NULL;
216
217    /*
218     * Create the default system engine.
219     */
220
221    tsdPtr->defaultEnginePtr =
222	    (StyleEngine *) Tk_RegisterStyleEngine(NULL, NULL);
223
224    /*
225     * Create the default system style.
226     */
227
228    Tk_CreateStyle(NULL, (Tk_StyleEngine) tsdPtr->defaultEnginePtr,
229	    (ClientData) 0);
230
231    tsdPtr->nbInit++;
232}
233
234/*
235 *---------------------------------------------------------------------------
236 *
237 * TkStylePkgFree --
238 *
239 *	This procedure is called when an application is deleted.  It
240 *	deletes all the structures that were used by the style package
241 *	for this application.
242 *
243 * Results:
244 *	None.
245 *
246 * Side effects:
247 *	Memory freed.
248 *
249 *---------------------------------------------------------------------------
250 */
251
252void
253TkStylePkgFree(mainPtr)
254    TkMainInfo *mainPtr;	/* The application being deleted. */
255{
256    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
257            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
258    Tcl_HashSearch search;
259    Tcl_HashEntry *entryPtr;
260    StyleEngine *enginePtr;
261    int i;
262
263    tsdPtr->nbInit--;
264    if (tsdPtr->nbInit != 0) return;
265
266    /*
267     * Free styles.
268     */
269
270    entryPtr = Tcl_FirstHashEntry(&tsdPtr->styleTable, &search);
271    while (entryPtr != NULL) {
272	ckfree((char *) Tcl_GetHashValue(entryPtr));
273	entryPtr = Tcl_NextHashEntry(&search);
274    }
275    Tcl_DeleteHashTable(&tsdPtr->styleTable);
276
277    /*
278     * Free engines.
279     */
280
281    entryPtr = Tcl_FirstHashEntry(&tsdPtr->engineTable, &search);
282    while (entryPtr != NULL) {
283	enginePtr = (StyleEngine *) Tcl_GetHashValue(entryPtr);
284	FreeStyleEngine(enginePtr);
285	ckfree((char *) enginePtr);
286	entryPtr = Tcl_NextHashEntry(&search);
287    }
288    Tcl_DeleteHashTable(&tsdPtr->engineTable);
289
290    /*
291     * Free elements.
292     */
293
294    for (i = 0; i < tsdPtr->nbElements; i++) {
295	FreeElement(tsdPtr->elements+i);
296    }
297    Tcl_DeleteHashTable(&tsdPtr->elementTable);
298    ckfree((char *) tsdPtr->elements);
299}
300
301/*
302 *---------------------------------------------------------------------------
303 *
304 * Tk_RegisterStyleEngine --
305 *
306 *	This procedure is called to register a new style engine. Style engines
307 *	are stored in thread-local space.
308 *
309 * Results:
310 *	The newly allocated engine.
311 *
312 * Side effects:
313 *	Memory allocated. Data added to thread-local table.
314 *
315 *---------------------------------------------------------------------------
316 */
317
318Tk_StyleEngine
319Tk_RegisterStyleEngine(name, parent)
320    CONST char *name;		/* Name of the engine to create. NULL or empty
321				 * means the default system engine. */
322    Tk_StyleEngine parent;	/* The engine's parent. NULL means the default
323				 * system engine. */
324{
325    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
326            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
327    Tcl_HashEntry *entryPtr;
328    int newEntry;
329    StyleEngine *enginePtr;
330
331    /*
332     * Attempt to create a new entry in the engine table.
333     */
334
335    entryPtr = Tcl_CreateHashEntry(&tsdPtr->engineTable, (name?name:""),
336	    &newEntry);
337    if (!newEntry) {
338	/*
339	 * An engine was already registered by that name.
340	 */
341
342	return NULL;
343    }
344
345    /*
346     * Allocate and intitialize a new engine.
347     */
348
349    enginePtr = (StyleEngine *) ckalloc(sizeof(StyleEngine));
350    InitStyleEngine(enginePtr, Tcl_GetHashKey(&tsdPtr->engineTable, entryPtr),
351	    (StyleEngine *) parent);
352    Tcl_SetHashValue(entryPtr, (ClientData) enginePtr);
353
354    return (Tk_StyleEngine) enginePtr;
355}
356
357/*
358 *---------------------------------------------------------------------------
359 *
360 * InitStyleEngine --
361 *
362 *	Initialize a newly allocated style engine.
363 *
364 * Results:
365 *	None.
366 *
367 * Side effects:
368 *	Memory allocated.
369 *
370 *---------------------------------------------------------------------------
371 */
372
373static void
374InitStyleEngine(enginePtr, name, parentPtr)
375    StyleEngine *enginePtr;	/* Points to an uninitialized engine. */
376    CONST char *name;		/* Name of the registered engine. NULL or empty
377				 * means the default system engine. Usually
378				 * points to the hash key. */
379    StyleEngine *parentPtr;	/* The engine's parent. NULL means the default
380				 * system engine. */
381{
382    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
383            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
384    int elementId;
385
386    if (name == NULL || *name == '\0') {
387	/*
388	 * This is the default style engine.
389	 */
390
391	enginePtr->parentPtr = NULL;
392
393    } else if (parentPtr == NULL) {
394	/*
395	 * The default style engine is the parent.
396	 */
397
398	enginePtr->parentPtr = tsdPtr->defaultEnginePtr;
399
400    } else {
401	enginePtr->parentPtr = parentPtr;
402    }
403
404    /*
405     * Allocate and initialize elements array.
406     */
407
408    if (tsdPtr->nbElements > 0) {
409	enginePtr->elements = (StyledElement *) ckalloc(
410		sizeof(StyledElement) * tsdPtr->nbElements);
411	for (elementId = 0; elementId < tsdPtr->nbElements; elementId++) {
412	    InitStyledElement(enginePtr->elements+elementId);
413	}
414    } else {
415	enginePtr->elements = NULL;
416    }
417}
418
419/*
420 *---------------------------------------------------------------------------
421 *
422 * FreeStyleEngine --
423 *
424 *	Free an engine and its associated data.
425 *
426 * Results:
427 *	None
428 *
429 * Side effects:
430 *	Memory freed.
431 *
432 *---------------------------------------------------------------------------
433 */
434
435static void
436FreeStyleEngine(enginePtr)
437    StyleEngine *enginePtr;	/* The style engine to free. */
438{
439    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
440            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
441    int elementId;
442
443    /*
444     * Free allocated elements.
445     */
446
447    for (elementId = 0; elementId < tsdPtr->nbElements; elementId++) {
448	FreeStyledElement(enginePtr->elements+elementId);
449    }
450    ckfree((char *) enginePtr->elements);
451}
452
453/*
454 *---------------------------------------------------------------------------
455 *
456 * Tk_GetStyleEngine --
457 *
458 *	Retrieve a registered style engine by its name.
459 *
460 * Results:
461 *	A pointer to the style engine, or NULL if none found.
462 *
463 * Side effects:
464 *	None.
465 *
466 *---------------------------------------------------------------------------
467 */
468
469Tk_StyleEngine
470Tk_GetStyleEngine(name)
471    CONST char *name;		/* Name of the engine to retrieve. NULL or
472				 * empty means the default system engine. */
473{
474    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
475            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
476    Tcl_HashEntry *entryPtr;
477
478    if (name == NULL) {
479	return (Tk_StyleEngine) tsdPtr->defaultEnginePtr;
480    }
481
482    entryPtr = Tcl_FindHashEntry(&tsdPtr->engineTable, (name?name:""));
483    if (!entryPtr) {
484	return NULL;
485    }
486
487    return (Tk_StyleEngine) Tcl_GetHashValue(entryPtr);
488}
489
490/*
491 *---------------------------------------------------------------------------
492 *
493 * InitElement --
494 *
495 *	Initialize a newly allocated element.
496 *
497 * Results:
498 *	None.
499 *
500 * Side effects:
501 *	None.
502 *
503 *---------------------------------------------------------------------------
504 */
505
506static void
507InitElement(elementPtr, name, id, genericId, created)
508    Element *elementPtr;	/* Points to an uninitialized element.*/
509    CONST char *name;		/* Name of the registered element. Usually
510				 * points to the hash key. */
511    int id;			/* Unique element ID. */
512    int genericId;		/* ID of generic element. -1 means none. */
513    int created;		/* Boolean, whether the element was created
514				 * explicitly (was registered) or implicitly
515				 * (by a derived element). */
516{
517    elementPtr->name = name;
518    elementPtr->id = id;
519    elementPtr->genericId = genericId;
520    elementPtr->created = (created?1:0);
521}
522
523/*
524 *---------------------------------------------------------------------------
525 *
526 * FreeElement --
527 *
528 *	Free an element and its associated data.
529 *
530 * Results:
531 *	None.
532 *
533 * Side effects:
534 *	Memory freed.
535 *
536 *---------------------------------------------------------------------------
537 */
538
539static void
540FreeElement(elementPtr)
541    Element *elementPtr;	/* The element to free. */
542{
543    /* Nothing to do. */
544}
545
546/*
547 *---------------------------------------------------------------------------
548 *
549 * InitStyledElement --
550 *
551 *	Initialize a newly allocated styled element.
552 *
553 * Results:
554 *	None.
555 *
556 * Side effects:
557 *	None.
558 *
559 *---------------------------------------------------------------------------
560 */
561
562static void
563InitStyledElement(elementPtr)
564    StyledElement *elementPtr;	/* Points to an uninitialized element.*/
565{
566    memset(elementPtr, 0, sizeof(StyledElement));
567}
568
569/*
570 *---------------------------------------------------------------------------
571 *
572 * FreeStyledElement --
573 *
574 *	Free a styled element and its associated data.
575 *
576 * Results:
577 *	None.
578 *
579 * Side effects:
580 *	Memory freed.
581 *
582 *---------------------------------------------------------------------------
583 */
584
585static void
586FreeStyledElement(elementPtr)
587    StyledElement *elementPtr;	/* The styled element to free. */
588{
589    int i;
590
591    /*
592     * Free allocated widget specs.
593     */
594
595    for (i = 0; i < elementPtr->nbWidgetSpecs; i++) {
596	FreeWidgetSpec(elementPtr->widgetSpecs+i);
597    }
598    ckfree((char *) elementPtr->widgetSpecs);
599}
600
601/*
602 *---------------------------------------------------------------------------
603 *
604 * CreateElement --
605 *
606 *	Find an existing or create a new element.
607 *
608 * Results:
609 *	The unique ID for the created or found element.
610 *
611 * Side effects:
612 *	Memory allocated.
613 *
614 *---------------------------------------------------------------------------
615 */
616
617static int
618CreateElement(name, create)
619    CONST char *name;	/* Name of the element. */
620    int create;		/* Boolean, whether the element is being created
621			 * explicitly (being registered) or implicitly (by a
622			 * derived element). */
623{
624    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
625            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
626    Tcl_HashEntry *entryPtr, *engineEntryPtr;
627    Tcl_HashSearch search;
628    int newEntry;
629    int elementId, genericId = -1;
630    char *dot;
631    StyleEngine *enginePtr;
632
633    /*
634     * Find or create the element.
635     */
636
637    entryPtr = Tcl_CreateHashEntry(&tsdPtr->elementTable, name, &newEntry);
638    if (!newEntry) {
639	elementId = (int) Tcl_GetHashValue(entryPtr);
640	if (create) {
641	    tsdPtr->elements[elementId].created = 1;
642	}
643	return elementId;
644    }
645
646    /*
647     * The element didn't exist. If it's a derived element, find or
648     * create its generic element ID.
649     */
650
651    dot = strchr(name, '.');
652    if (dot) {
653	genericId = CreateElement(dot+1, 0);
654    }
655
656    elementId = tsdPtr->nbElements++;
657    Tcl_SetHashValue(entryPtr, (ClientData) elementId);
658
659    /*
660     * Reallocate element table.
661     */
662
663    tsdPtr->elements = (Element *) ckrealloc((char *) tsdPtr->elements,
664	    sizeof(Element) * tsdPtr->nbElements);
665    InitElement(tsdPtr->elements+elementId,
666	    Tcl_GetHashKey(&tsdPtr->elementTable, entryPtr), elementId,
667	    genericId, create);
668
669    /*
670     * Reallocate style engines' element table.
671     */
672
673    engineEntryPtr = Tcl_FirstHashEntry(&tsdPtr->engineTable, &search);
674    while (engineEntryPtr != NULL) {
675	enginePtr = (StyleEngine *) Tcl_GetHashValue(engineEntryPtr);
676
677	enginePtr->elements = (StyledElement *) ckrealloc(
678		(char *) enginePtr->elements,
679		sizeof(StyledElement) * tsdPtr->nbElements);
680	InitStyledElement(enginePtr->elements+elementId);
681
682	engineEntryPtr = Tcl_NextHashEntry(&search);
683    }
684
685    return elementId;
686}
687
688/*
689 *---------------------------------------------------------------------------
690 *
691 * Tk_GetElementId --
692 *
693 *	Find an existing element.
694 *
695 * Results:
696 *	The unique ID for the found element, or -1 if not found.
697 *
698 * Side effects:
699 *	Generic elements may be created.
700 *
701 *---------------------------------------------------------------------------
702 */
703
704int
705Tk_GetElementId(name)
706    CONST char *name;		/* Name of the element. */
707{
708    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
709            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
710    Tcl_HashEntry *entryPtr;
711    int genericId = -1;
712    char *dot;
713
714    /*
715     * Find the element Id.
716     */
717
718    entryPtr = Tcl_FindHashEntry(&tsdPtr->elementTable, name);
719    if (entryPtr) {
720	return (int) Tcl_GetHashValue(entryPtr);
721    }
722
723    /*
724     * Element not found. If the given name was derived, then first search for
725     * the generic element. If found, create the new derived element.
726     */
727
728    dot = strchr(name, '.');
729    if (!dot) {
730	return -1;
731    }
732    genericId = Tk_GetElementId(dot+1);
733    if (genericId == -1) {
734	return -1;
735    }
736    if (!tsdPtr->elements[genericId].created) {
737	/*
738	 * The generic element was created implicitly and thus has no real
739	 * existence.
740	 */
741
742	return -1;
743    } else {
744	/*
745	 * The generic element was created explicitly. Create the derived
746	 * element.
747	 */
748
749	return CreateElement(name, 1);
750    }
751}
752
753/*
754 *---------------------------------------------------------------------------
755 *
756 * Tk_RegisterStyledElement --
757 *
758 *	Register an implementation of a new or existing element for the
759 *	given style engine.
760 *
761 * Results:
762 *	The unique ID for the created or found element.
763 *
764 * Side effects:
765 *	Elements may be created. Memory allocated.
766 *
767 *---------------------------------------------------------------------------
768 */
769
770int
771Tk_RegisterStyledElement(engine, templatePtr)
772    Tk_StyleEngine engine;		/* Style engine providing the
773					 * implementation. */
774    Tk_ElementSpec *templatePtr;	/* Static template information about
775					 * the element. */
776{
777    int elementId;
778    StyledElement *elementPtr;
779    Tk_ElementSpec *specPtr;
780    int nbOptions;
781    register Tk_ElementOptionSpec *srcOptions, *dstOptions;
782
783    if (templatePtr->version != TK_STYLE_VERSION_1) {
784	/*
785	 * Version mismatch. Do nothing.
786	 */
787
788	return -1;
789    }
790
791    if (engine == NULL) {
792	engine = Tk_GetStyleEngine(NULL);
793    }
794
795    /*
796     * Register the element, allocating storage in the various engines if
797     * necessary.
798     */
799
800    elementId = CreateElement(templatePtr->name, 1);
801
802    /*
803     * Initialize the styled element.
804     */
805
806    elementPtr = ((StyleEngine *) engine)->elements+elementId;
807
808    specPtr = (Tk_ElementSpec *) ckalloc(sizeof(Tk_ElementSpec));
809    specPtr->version = templatePtr->version;
810    specPtr->name = ckalloc(strlen(templatePtr->name)+1);
811    strcpy(specPtr->name, templatePtr->name);
812    nbOptions = 0;
813    for (nbOptions = 0, srcOptions = templatePtr->options;
814	 srcOptions->name != NULL;
815	 nbOptions++, srcOptions++);
816    specPtr->options = (Tk_ElementOptionSpec *) ckalloc(
817	    sizeof(Tk_ElementOptionSpec) * (nbOptions+1));
818    for (srcOptions = templatePtr->options, dstOptions = specPtr->options;
819	 /* End condition within loop */;
820	 srcOptions++, dstOptions++) {
821	if (srcOptions->name == NULL) {
822	    dstOptions->name = NULL;
823	    break;
824	}
825
826	dstOptions->name = ckalloc(strlen(srcOptions->name)+1);
827	strcpy(dstOptions->name, srcOptions->name);
828	dstOptions->type = srcOptions->type;
829    }
830    specPtr->getSize = templatePtr->getSize;
831    specPtr->getBox = templatePtr->getBox;
832    specPtr->getBorderWidth = templatePtr->getBorderWidth;
833    specPtr->draw = templatePtr->draw;
834
835    elementPtr->specPtr = specPtr;
836    elementPtr->nbWidgetSpecs = 0;
837    elementPtr->widgetSpecs = NULL;
838
839    return elementId;
840}
841
842/*
843 *---------------------------------------------------------------------------
844 *
845 * GetStyledElement --
846 *
847 *	Get a registered implementation of an existing element for the
848 *	given style engine.
849 *
850 * Results:
851 *	The styled element descriptor, or NULL if not found.
852 *
853 * Side effects:
854 *	None.
855 *
856 *---------------------------------------------------------------------------
857 */
858
859static StyledElement *
860GetStyledElement(enginePtr, elementId)
861    StyleEngine *enginePtr;	/* Style engine providing the implementation.
862				 * NULL means the default system engine. */
863    int elementId;		/* Unique element ID */{
864    StyledElement *elementPtr;
865    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
866	    Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
867    StyleEngine *enginePtr2;
868
869    if (enginePtr == NULL) {
870	enginePtr = tsdPtr->defaultEnginePtr;
871    }
872
873    while (elementId >= 0 && elementId < tsdPtr->nbElements) {
874	/*
875	 * Look for an implemented element through the engine chain.
876	 */
877
878	enginePtr2 = enginePtr;
879	do {
880	    elementPtr = enginePtr2->elements+elementId;
881	    if (elementPtr->specPtr != NULL) {
882		return elementPtr;
883	    }
884	    enginePtr2 = enginePtr2->parentPtr;
885	} while (enginePtr2 != NULL);
886
887	/*
888	 * None found, try with the generic element.
889	 */
890
891	elementId = tsdPtr->elements[elementId].genericId;
892    }
893
894    /*
895     * No matching element found.
896     */
897
898    return NULL;
899}
900
901/*
902 *---------------------------------------------------------------------------
903 *
904 * InitWidgetSpec --
905 *
906 *	Initialize a newly allocated widget spec.
907 *
908 * Results:
909 *	None.
910 *
911 * Side effects:
912 *	Memory allocated.
913 *
914 *---------------------------------------------------------------------------
915 */
916
917static void
918InitWidgetSpec(widgetSpecPtr, elementPtr, optionTable)
919    StyledWidgetSpec *widgetSpecPtr;	/* Points to an uninitialized widget
920					 * spec. */
921    StyledElement *elementPtr;		/* Styled element descriptor. */
922    Tk_OptionTable optionTable;		/* The widget's option table. */
923{
924    int i, nbOptions;
925    Tk_ElementOptionSpec *elementOptionPtr;
926    CONST Tk_OptionSpec *widgetOptionPtr;
927
928    widgetSpecPtr->elementPtr = elementPtr;
929    widgetSpecPtr->optionTable = optionTable;
930
931    /*
932     * Count the number of options.
933     */
934
935    for (nbOptions = 0, elementOptionPtr = elementPtr->specPtr->options;
936	    elementOptionPtr->name != NULL;
937	    nbOptions++, elementOptionPtr++) {
938    }
939
940    /*
941     * Build the widget option list.
942     */
943
944    widgetSpecPtr->optionsPtr = (CONST Tk_OptionSpec **) ckalloc(
945	    sizeof(Tk_OptionSpec *) * nbOptions);
946    for (i = 0, elementOptionPtr = elementPtr->specPtr->options;
947	    i < nbOptions;
948	    i++, elementOptionPtr++) {
949	widgetOptionPtr = TkGetOptionSpec(elementOptionPtr->name, optionTable);
950
951	/*
952	 * Check that the widget option type is compatible with one of the
953	 * element's required types.
954	 */
955
956	if (   elementOptionPtr->type == TK_OPTION_END
957	    || elementOptionPtr->type == widgetOptionPtr->type) {
958	    widgetSpecPtr->optionsPtr[i] = widgetOptionPtr;
959	} else {
960	    widgetSpecPtr->optionsPtr[i] = NULL;
961	}
962    }
963}
964
965/*
966 *---------------------------------------------------------------------------
967 *
968 * FreeWidgetSpec --
969 *
970 *	Free a widget spec and its associated data.
971 *
972 * Results:
973 *	None
974 *
975 * Side effects:
976 *	Memory freed.
977 *
978 *---------------------------------------------------------------------------
979 */
980
981static void
982FreeWidgetSpec(widgetSpecPtr)
983    StyledWidgetSpec *widgetSpecPtr;	/* The widget spec to free. */
984{
985    ckfree((char *) widgetSpecPtr->optionsPtr);
986}
987
988/*
989 *---------------------------------------------------------------------------
990 *
991 * GetWidgetSpec --
992 *
993 *	Return a new or existing widget spec for the given element and
994 *	widget type (identified by its option table).
995 *
996 * Results:
997 *	A pointer to the matching widget spec.
998 *
999 * Side effects:
1000 *	Memory may be allocated.
1001 *
1002 *---------------------------------------------------------------------------
1003 */
1004
1005static StyledWidgetSpec *
1006GetWidgetSpec(elementPtr, optionTable)
1007    StyledElement *elementPtr;		/* Styled element descriptor. */
1008    Tk_OptionTable optionTable;		/* The widget's option table. */
1009{
1010    StyledWidgetSpec *widgetSpecPtr;
1011    int i;
1012
1013    /*
1014     * Try to find an existing widget spec.
1015     */
1016
1017    for (i = 0; i < elementPtr->nbWidgetSpecs; i++) {
1018	widgetSpecPtr = elementPtr->widgetSpecs+i;
1019	if (widgetSpecPtr->optionTable == optionTable) {
1020	    return widgetSpecPtr;
1021	}
1022    }
1023
1024    /*
1025     * Create and initialize a new widget spec.
1026     */
1027
1028    i = elementPtr->nbWidgetSpecs++;
1029    elementPtr->widgetSpecs = (StyledWidgetSpec *) ckrealloc(
1030	    (char *) elementPtr->widgetSpecs,
1031	    sizeof(StyledWidgetSpec) * elementPtr->nbWidgetSpecs);
1032    widgetSpecPtr = elementPtr->widgetSpecs+i;
1033    InitWidgetSpec(widgetSpecPtr, elementPtr, optionTable);
1034
1035    return widgetSpecPtr;
1036}
1037
1038/*
1039 *---------------------------------------------------------------------------
1040 *
1041 * Tk_GetStyledElement --
1042 *
1043 *	This procedure returns a styled instance of the given element.
1044 *
1045 * Results:
1046 *	None.
1047 *
1048 * Side effects:
1049 *	Cached data may be allocated or updated.
1050 *
1051 *---------------------------------------------------------------------------
1052 */
1053
1054Tk_StyledElement
1055Tk_GetStyledElement(style, elementId, optionTable)
1056    Tk_Style style;		/* The widget style. */
1057    int elementId;		/* Unique element ID. */
1058    Tk_OptionTable optionTable;	/* Option table for the widget. */
1059{
1060    Style *stylePtr = (Style *) style;
1061    StyledElement *elementPtr;
1062
1063    /*
1064     * Get an element implementation and call corresponding hook.
1065     */
1066
1067    elementPtr = GetStyledElement((stylePtr?stylePtr->enginePtr:NULL),
1068	    elementId);
1069    if (!elementPtr) {
1070	return NULL;
1071    }
1072
1073    return (Tk_StyledElement) GetWidgetSpec(elementPtr, optionTable);
1074}
1075
1076/*
1077 *---------------------------------------------------------------------------
1078 *
1079 * Tk_GetElementSize --
1080 *
1081 *	This procedure computes the size of the given widget element according
1082 *	to its style.
1083 *
1084 * Results:
1085 *	None.
1086 *
1087 * Side effects:
1088 *	Cached data may be allocated or updated.
1089 *
1090 *---------------------------------------------------------------------------
1091 */
1092
1093void
1094Tk_GetElementSize(style, element, recordPtr, tkwin, width, height, inner, widthPtr,
1095	heightPtr)
1096    Tk_Style style;			/* The widget style. */
1097    Tk_StyledElement element;		/* The styled element, previously
1098					 * returned by Tk_GetStyledElement. */
1099    char *recordPtr;			/* The widget record. */
1100    Tk_Window tkwin;			/* The widget window. */
1101    int width, height;			/* Requested size. */
1102    int inner;				/* Boolean. If TRUE, compute the outer
1103					 * size according to the requested
1104					 * minimum inner size. If FALSE, compute
1105					 * the inner size according to the
1106					 * requested maximum outer size. */
1107    int *widthPtr, *heightPtr;		/* Returned size. */
1108{
1109    Style *stylePtr = (Style *) style;
1110    StyledWidgetSpec *widgetSpecPtr = (StyledWidgetSpec *) element;
1111
1112    widgetSpecPtr->elementPtr->specPtr->getSize(stylePtr->clientData,
1113	    recordPtr, widgetSpecPtr->optionsPtr, tkwin, width, height, inner,
1114	    widthPtr, heightPtr);
1115}
1116
1117/*
1118 *---------------------------------------------------------------------------
1119 *
1120 * Tk_GetElementBox --
1121 *
1122 *	This procedure computes the bounding or inscribed box coordinates
1123 *	of the given widget element according to its style and within the
1124 *	given limits.
1125 *
1126 * Results:
1127 *	None.
1128 *
1129 * Side effects:
1130 *	Cached data may be allocated or updated.
1131 *
1132 *---------------------------------------------------------------------------
1133 */
1134
1135void
1136Tk_GetElementBox(style, element, recordPtr, tkwin, x, y, width, height, inner,
1137	xPtr, yPtr, widthPtr, heightPtr)
1138    Tk_Style style;			/* The widget style. */
1139    Tk_StyledElement element;		/* The styled element, previously
1140					 * returned by Tk_GetStyledElement. */
1141    char *recordPtr;			/* The widget record. */
1142    Tk_Window tkwin;			/* The widget window. */
1143    int x, y;				/* Top left corner of available area. */
1144    int width, height;			/* Size of available area. */
1145    int inner;				/* Boolean. If TRUE, compute the
1146					 * bounding box according to the
1147					 * requested inscribed box size. If
1148					 * FALSE, compute the inscribed box
1149					 * according to the requested bounding
1150					 * box. */
1151    int *xPtr, *yPtr;			/* Returned top left corner. */
1152    int *widthPtr, *heightPtr;		/* Returned size. */
1153{
1154    Style *stylePtr = (Style *) style;
1155    StyledWidgetSpec *widgetSpecPtr = (StyledWidgetSpec *) element;
1156
1157    widgetSpecPtr->elementPtr->specPtr->getBox(stylePtr->clientData,
1158	    recordPtr, widgetSpecPtr->optionsPtr, tkwin, x, y, width, height,
1159	    inner, xPtr, yPtr, widthPtr, heightPtr);
1160}
1161
1162/*
1163 *---------------------------------------------------------------------------
1164 *
1165 * Tk_GetElementBorderWidth --
1166 *
1167 *	This procedure computes the border widthof the given widget element
1168 *	according to its style and within the given limits.
1169 *
1170 * Results:
1171 *	Border width in pixels. This value is uniform for all four sides.
1172 *
1173 * Side effects:
1174 *	Cached data may be allocated or updated.
1175 *
1176 *---------------------------------------------------------------------------
1177 */
1178
1179int
1180Tk_GetElementBorderWidth(style, element, recordPtr, tkwin)
1181    Tk_Style style;			/* The widget style. */
1182    Tk_StyledElement element;		/* The styled element, previously
1183					 * returned by Tk_GetStyledElement. */
1184    char *recordPtr;			/* The widget record. */
1185    Tk_Window tkwin;			/* The widget window. */
1186{
1187    Style *stylePtr = (Style *) style;
1188    StyledWidgetSpec *widgetSpecPtr = (StyledWidgetSpec *) element;
1189
1190    return widgetSpecPtr->elementPtr->specPtr->getBorderWidth(
1191	    stylePtr->clientData, recordPtr, widgetSpecPtr->optionsPtr, tkwin);
1192}
1193
1194/*
1195 *---------------------------------------------------------------------------
1196 *
1197 * Tk_DrawElement --
1198 *
1199 *	This procedure draw the given widget element in a given drawable area.
1200 *
1201 * Results:
1202 *	None
1203 *
1204 * Side effects:
1205 *	Cached data may be allocated or updated.
1206 *
1207 *---------------------------------------------------------------------------
1208 */
1209
1210void
1211Tk_DrawElement(style, element, recordPtr, tkwin, d, x, y, width, height, state)
1212    Tk_Style style;			/* The widget style. */
1213    Tk_StyledElement element;		/* The styled element, previously
1214					 * returned by Tk_GetStyledElement. */
1215    char *recordPtr;			/* The widget record. */
1216    Tk_Window tkwin;			/* The widget window. */
1217    Drawable d;				/* Where to draw element. */
1218    int x, y;				/* Top left corner of element. */
1219    int width, height;			/* Size of element. */
1220    int state;				/* Drawing state flags. */
1221{
1222    Style *stylePtr = (Style *) style;
1223    StyledWidgetSpec *widgetSpecPtr = (StyledWidgetSpec *) element;
1224
1225    widgetSpecPtr->elementPtr->specPtr->draw(stylePtr->clientData,
1226	    recordPtr, widgetSpecPtr->optionsPtr, tkwin, d, x, y, width,
1227	    height, state);
1228}
1229
1230/*
1231 *---------------------------------------------------------------------------
1232 *
1233 * Tk_CreateStyle --
1234 *
1235 *	This procedure is called to create a new style as an instance of the
1236 *	given engine. Styles are stored in thread-local space.
1237 *
1238 * Results:
1239 *	The newly allocated style.
1240 *
1241 * Side effects:
1242 *	Memory allocated. Data added to thread-local table. The style's
1243 *	refCount is incremented.
1244 *
1245 *---------------------------------------------------------------------------
1246 */
1247
1248Tk_Style
1249Tk_CreateStyle(name, engine, clientData)
1250    CONST char *name;		/* Name of the style to create. NULL or empty
1251				 * means the default system style. */
1252    Tk_StyleEngine engine;	/* The style engine. */
1253    ClientData clientData;	/* Private data passed as is to engine code. */
1254{
1255    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
1256            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
1257    Tcl_HashEntry *entryPtr;
1258    int newEntry;
1259    Style *stylePtr;
1260
1261    /*
1262     * Attempt to create a new entry in the style table.
1263     */
1264
1265    entryPtr = Tcl_CreateHashEntry(&tsdPtr->styleTable, (name?name:""),
1266	    &newEntry);
1267    if (!newEntry) {
1268	/*
1269	 * A style was already registered by that name.
1270	 */
1271
1272	return NULL;
1273    }
1274
1275    /*
1276     * Allocate and intitialize a new style.
1277     */
1278
1279    stylePtr = (Style *) ckalloc(sizeof(Style));
1280    InitStyle(stylePtr, entryPtr, Tcl_GetHashKey(&tsdPtr->styleTable, entryPtr),
1281	    (engine?(StyleEngine *) engine:tsdPtr->defaultEnginePtr), clientData);
1282    Tcl_SetHashValue(entryPtr, (ClientData) stylePtr);
1283    stylePtr->refCount++;
1284
1285    return (Tk_Style) stylePtr;
1286}
1287
1288/*
1289 *---------------------------------------------------------------------------
1290 *
1291 * Tk_NameOfStyle --
1292 *
1293 *	Given a style, return its registered name.
1294 *
1295 * Results:
1296 *	The return value is the name that was passed to Tk_CreateStyle() to
1297 *	create the style.  The storage for the returned string is private
1298 *	(it points to the corresponding hash key) The caller should not modify
1299 *	this string.
1300 *
1301 * Side effects:
1302 *	None.
1303 *
1304 *---------------------------------------------------------------------------
1305 */
1306
1307CONST char *
1308Tk_NameOfStyle(style)
1309    Tk_Style style;		/* Style whose name is desired. */
1310{
1311    Style *stylePtr = (Style *) style;
1312
1313    return stylePtr->name;
1314}
1315
1316/*
1317 *---------------------------------------------------------------------------
1318 *
1319 * InitStyle --
1320 *
1321 *	Initialize a newly allocated style.
1322 *
1323 * Results:
1324 *	None.
1325 *
1326 * Side effects:
1327 *	None.
1328 *
1329 *---------------------------------------------------------------------------
1330 */
1331
1332static void
1333InitStyle(stylePtr, hashPtr, name, enginePtr, clientData)
1334    Style *stylePtr;		/* Points to an uninitialized style. */
1335    Tcl_HashEntry *hashPtr;	/* Hash entry for the registered style. */
1336    CONST char *name;		/* Name of the registered style. NULL or empty
1337				 * means the default system style. Usually
1338				 * points to the hash key. */
1339    StyleEngine *enginePtr;	/* The style engine. */
1340    ClientData clientData;	/* Private data passed as is to engine code. */
1341{
1342    stylePtr->refCount = 0;
1343    stylePtr->hashPtr = hashPtr;
1344    stylePtr->name = name;
1345    stylePtr->enginePtr = enginePtr;
1346    stylePtr->clientData = clientData;
1347}
1348
1349/*
1350 *---------------------------------------------------------------------------
1351 *
1352 * FreeStyle --
1353 *
1354 *	Free a style and its associated data.
1355 *
1356 * Results:
1357 *	None
1358 *
1359 * Side effects:
1360 *	None.
1361 *
1362 *---------------------------------------------------------------------------
1363 */
1364
1365static void
1366FreeStyle(stylePtr)
1367    Style *stylePtr;		/* The style to free. */
1368{
1369    /* Nothing to do. */
1370}
1371
1372/*
1373 *---------------------------------------------------------------------------
1374 *
1375 * Tk_GetStyle --
1376 *
1377 *	Retrieve a registered style by its name.
1378 *
1379 * Results:
1380 *	A pointer to the style engine, or NULL if none found.  In the latter
1381 *	case and if the interp is not NULL, an error message is left in the
1382 *	interp's result.
1383 *
1384 * Side effects:
1385 *	None.
1386 *
1387 *---------------------------------------------------------------------------
1388 */
1389
1390Tk_Style
1391Tk_GetStyle(interp, name)
1392    Tcl_Interp *interp;		/* Interp for error return. */
1393    CONST char *name;		/* Name of the style to retrieve. NULL or empty
1394				 * means the default system style. */
1395{
1396    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
1397            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
1398    Tcl_HashEntry *entryPtr;
1399    Style *stylePtr;
1400
1401    /*
1402     * Search for a corresponding entry in the style table.
1403     */
1404
1405    entryPtr = Tcl_FindHashEntry(&tsdPtr->styleTable, (name?name:""));
1406    if (entryPtr == NULL) {
1407	if (interp != NULL) {
1408	    Tcl_AppendResult(interp, "style \"", name, "\" doesn't exist", NULL);
1409	}
1410	return (Tk_Style) NULL;
1411    }
1412    stylePtr = (Style *) Tcl_GetHashValue(entryPtr);
1413    stylePtr->refCount++;
1414
1415    return (Tk_Style) stylePtr;
1416}
1417
1418/*
1419 *---------------------------------------------------------------------------
1420 *
1421 * Tk_FreeStyle --
1422 *
1423 *	Free a style previously created by Tk_CreateStyle.
1424 *
1425 * Results:
1426 *	None
1427 *
1428 * Side effects:
1429 *	The style's refCount is decremented. If it reaches zero, the style
1430 *	is freed.
1431 *
1432 *---------------------------------------------------------------------------
1433 */
1434
1435void
1436Tk_FreeStyle(style)
1437    Tk_Style style;		/* The style to free. */
1438{
1439    Style *stylePtr = (Style *) style;
1440
1441    if (stylePtr == NULL) {
1442	return;
1443    }
1444    stylePtr->refCount--;
1445    if (stylePtr->refCount > 0) {
1446	return;
1447    }
1448
1449    /*
1450     * Keep the default style alive.
1451     */
1452
1453    if (*stylePtr->name == '\0') {
1454	stylePtr->refCount = 1;
1455	return;
1456    }
1457
1458    Tcl_DeleteHashEntry(stylePtr->hashPtr);
1459    FreeStyle(stylePtr);
1460    ckfree((char *) stylePtr);
1461}
1462
1463/*
1464 *---------------------------------------------------------------------------
1465 *
1466 * Tk_AllocStyleFromObj --
1467 *
1468 *	Map the string name of a style to a corresponding Tk_Style. The style
1469 *	must have already been created by Tk_CreateStyle.
1470 *
1471 * Results:
1472 *	The return value is a token for the style that matches objPtr, or
1473 *	NULL if none found.  If NULL is returned, an error message will be
1474 *	left in interp's result object.
1475 *
1476 * Side effects:
1477 * 	The style's reference count is incremented. For each call to this
1478 *	procedure, there should eventually be a call to Tk_FreeStyle() or
1479 *	Tk_FreeStyleFromObj() so that the database is cleaned up when styles
1480 *	aren't in use anymore.
1481 *
1482 *---------------------------------------------------------------------------
1483 */
1484
1485Tk_Style
1486Tk_AllocStyleFromObj(interp, objPtr)
1487    Tcl_Interp *interp;		/* Interp for error return. */
1488    Tcl_Obj *objPtr;		/* Object containing name of the style to
1489				 * retrieve. */
1490{
1491    Style *stylePtr;
1492
1493    if (objPtr->typePtr != &styleObjType) {
1494	SetStyleFromAny(interp, objPtr);
1495	stylePtr = (Style *) objPtr->internalRep.otherValuePtr;
1496    } else {
1497	stylePtr = (Style *) objPtr->internalRep.otherValuePtr;
1498	stylePtr->refCount++;
1499    }
1500
1501    return (Tk_Style) stylePtr;
1502}
1503
1504/*
1505 *----------------------------------------------------------------------
1506 *
1507 * Tk_GetStyleFromObj --
1508 *
1509 *	Find the style that corresponds to a given object.  The style must
1510 *	have already been created by Tk_CreateStyle.
1511 *
1512 * Results:
1513 *	The return value is a token for the style that matches objPtr, or
1514 *	NULL if none found.
1515 *
1516 * Side effects:
1517 *	If the object is not already a style ref, the conversion will free
1518 *	any old internal representation.
1519 *
1520 *----------------------------------------------------------------------
1521 */
1522
1523Tk_Style
1524Tk_GetStyleFromObj(objPtr)
1525    Tcl_Obj *objPtr;		/* The object from which to get the style. */
1526{
1527    if (objPtr->typePtr != &styleObjType) {
1528	SetStyleFromAny((Tcl_Interp *) NULL, objPtr);
1529    }
1530
1531    return (Tk_Style) objPtr->internalRep.otherValuePtr;
1532}
1533
1534/*
1535 *---------------------------------------------------------------------------
1536 *
1537 * Tk_FreeStyleFromObj --
1538 *
1539 *	Called to release a style inside a Tcl_Obj *.
1540 *
1541 * Results:
1542 *	None.
1543 *
1544 * Side effects:
1545 *	If the object is a style ref, the conversion will free its
1546 *	internal representation.
1547 *
1548 *---------------------------------------------------------------------------
1549 */
1550
1551void
1552Tk_FreeStyleFromObj(objPtr)
1553    Tcl_Obj *objPtr;		/* The Tcl_Obj * to be freed. */
1554{
1555    if (objPtr->typePtr == &styleObjType) {
1556	FreeStyleObjProc(objPtr);
1557    }
1558}
1559
1560/*
1561 *----------------------------------------------------------------------
1562 *
1563 * SetStyleFromAny --
1564 *
1565 *	Convert the internal representation of a Tcl object to the
1566 *	style internal form.
1567 *
1568 * Results:
1569 *	Always returns TCL_OK.  If an error occurs is returned (e.g. the
1570 *	style doesn't exist), an error message will be left in interp's
1571 *	result.
1572 *
1573 * Side effects:
1574 *	The object is left with its typePtr pointing to styleObjType.
1575 *	The reference count is incremented (in Tk_GetStyle()).
1576 *
1577 *----------------------------------------------------------------------
1578 */
1579
1580static int
1581SetStyleFromAny(interp, objPtr)
1582    Tcl_Interp *interp;		/* Used for error reporting if not NULL. */
1583    Tcl_Obj *objPtr;		/* The object to convert. */
1584{
1585    Tcl_ObjType *typePtr;
1586    char *name;
1587
1588    /*
1589     * Free the old internalRep before setting the new one.
1590     */
1591
1592    name = Tcl_GetString(objPtr);
1593    typePtr = objPtr->typePtr;
1594    if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
1595	(*typePtr->freeIntRepProc)(objPtr);
1596    }
1597
1598    objPtr->typePtr = &styleObjType;
1599    objPtr->internalRep.otherValuePtr = (VOID *) Tk_GetStyle(interp, name);
1600
1601    return TCL_OK;
1602}
1603
1604/*
1605 *---------------------------------------------------------------------------
1606 *
1607 * FreeStyleObjProc --
1608 *
1609 *	This proc is called to release an object reference to a style.
1610 *	Called when the object's internal rep is released.
1611 *
1612 * Results:
1613 *	None.
1614 *
1615 * Side effects:
1616 *	The reference count is decremented (in Tk_FreeStyle()).
1617 *
1618 *---------------------------------------------------------------------------
1619 */
1620
1621static void
1622FreeStyleObjProc(objPtr)
1623    Tcl_Obj *objPtr;		/* The object we are releasing. */
1624{
1625    Style *stylePtr = (Style *) objPtr->internalRep.otherValuePtr;
1626
1627    if (stylePtr != NULL) {
1628	Tk_FreeStyle((Tk_Style) stylePtr);
1629	objPtr->internalRep.otherValuePtr = NULL;
1630    }
1631}
1632
1633/*
1634 *---------------------------------------------------------------------------
1635 *
1636 * DupStyleObjProc --
1637 *
1638 *	When a cached style object is duplicated, this is called to
1639 *	update the internal reps.
1640 *
1641 * Results:
1642 *	None.
1643 *
1644 * Side effects:
1645 *	The style's refCount is incremented and the internal rep of the copy
1646 *	is set to point to it.
1647 *
1648 *---------------------------------------------------------------------------
1649 */
1650
1651static void
1652DupStyleObjProc(srcObjPtr, dupObjPtr)
1653    Tcl_Obj *srcObjPtr;		/* The object we are copying from. */
1654    Tcl_Obj *dupObjPtr;		/* The object we are copying to. */
1655{
1656    Style *stylePtr = (Style *) srcObjPtr->internalRep.otherValuePtr;
1657
1658    dupObjPtr->typePtr = srcObjPtr->typePtr;
1659    dupObjPtr->internalRep.otherValuePtr = (VOID *) stylePtr;
1660
1661    if (stylePtr != NULL) {
1662	stylePtr->refCount++;
1663    }
1664}
1665