/[dtapublic]/projs/trunk/shared_source/c_tk_base_7_5_w_mods/tkconfig.c
ViewVC logotype

Annotation of /projs/trunk/shared_source/c_tk_base_7_5_w_mods/tkconfig.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 44 - (hide annotations) (download)
Fri Oct 14 02:09:58 2016 UTC (7 years, 5 months ago) by dashley
File MIME type: text/plain
File size: 61734 byte(s)
Rename for reorganization.
1 dashley 25 /* $Header: /cvsroot/esrg/sfesrg/esrgpcpj/shared/tk_base/tkconfig.c,v 1.1.1.1 2001/06/13 04:58:49 dtashley Exp $ */
2    
3     /*
4     * tkConfig.c --
5     *
6     * This file contains procedures that manage configuration options
7     * for widgets and other things.
8     *
9     * Copyright (c) 1997-1998 Sun Microsystems, Inc.
10     *
11     * See the file "license.terms" for information on usage and redistribution
12     * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
13     *
14     * RCS: @(#) $Id: tkconfig.c,v 1.1.1.1 2001/06/13 04:58:49 dtashley Exp $
15     */
16    
17     /*
18     * Temporary flag for working on new config package.
19     */
20    
21     #if 0
22    
23     /*
24     * used only for removing the old config code
25     */
26    
27     #define __NO_OLD_CONFIG
28     #endif
29    
30     #include "tk.h"
31     #include "tkInt.h"
32     #include "tkPort.h"
33     #include "tkFont.h"
34    
35     /*
36     * The following definition is an AssocData key used to keep track of
37     * all of the option tables that have been created for an interpreter.
38     */
39    
40     #define OPTION_HASH_KEY "TkOptionTable"
41    
42     /*
43     * The following two structures are used along with Tk_OptionSpec
44     * structures to manage configuration options. Tk_OptionSpec is
45     * static templates that are compiled into the code of a widget
46     * or other object manager. However, to look up options efficiently
47     * we need to supplement the static information with additional
48     * dynamic information, and this dynamic information may be different
49     * for each application. Thus we create structures of the following
50     * two types to hold all of the dynamic information; this is done
51     * by Tk_CreateOptionTable.
52     *
53     * One of the following structures corresponds to each Tk_OptionSpec.
54     * These structures exist as arrays inside TkOptionTable structures.
55     */
56    
57     typedef struct TkOption {
58     CONST Tk_OptionSpec *specPtr; /* The original spec from the template
59     * passed to Tk_CreateOptionTable.*/
60     Tk_Uid dbNameUID; /* The Uid form of the option database
61     * name. */
62     Tk_Uid dbClassUID; /* The Uid form of the option database
63     * class name. */
64     Tcl_Obj *defaultPtr; /* Default value for this option. */
65     union {
66     Tcl_Obj *monoColorPtr; /* For color and border options, this
67     * is an alternate default value to
68     * use on monochrome displays. */
69     struct TkOption *synonymPtr; /* For synonym options, this points to
70     * the master entry. */
71     } extra;
72     int flags; /* Miscellaneous flag values; see
73     * below for definitions. */
74     } Option;
75    
76     /*
77     * Flag bits defined for Option structures:
78     *
79     * OPTION_NEEDS_FREEING - 1 means that FreeResources must be
80     * invoke to free resources associated with
81     * the option when it is no longer needed.
82     */
83    
84     #define OPTION_NEEDS_FREEING 1
85    
86     /*
87     * One of the following exists for each Tk_OptionSpec array that has
88     * been passed to Tk_CreateOptionTable.
89     */
90    
91     typedef struct OptionTable {
92     int refCount; /* Counts the number of uses of this
93     * table (the number of times
94     * Tk_CreateOptionTable has returned
95     * it). This can be greater than 1 if
96     * it is shared along several option
97     * table chains, or if the same table
98     * is used for multiple purposes. */
99     Tcl_HashEntry *hashEntryPtr; /* Hash table entry that refers to this
100     * table; used to delete the entry. */
101     struct OptionTable *nextPtr; /* If templatePtr was part of a chain
102     * of templates, this points to the
103     * table corresponding to the next
104     * template in the chain. */
105     int numOptions; /* The number of items in the options
106     * array below. */
107     Option options[1]; /* Information about the individual
108     * options in the table. This must be
109     * the last field in the structure:
110     * the actual size of the array will
111     * be numOptions, not 1. */
112     } OptionTable;
113    
114     /*
115     * Forward declarations for procedures defined later in this file:
116     */
117    
118     static int DoObjConfig _ANSI_ARGS_((Tcl_Interp *interp,
119     char *recordPtr, Option *optionPtr,
120     Tcl_Obj *valuePtr, Tk_Window tkwin,
121     Tk_SavedOption *savePtr));
122     static void DestroyOptionHashTable _ANSI_ARGS_((
123     ClientData clientData, Tcl_Interp *interp));
124     static void FreeResources _ANSI_ARGS_((Option *optionPtr,
125     Tcl_Obj *objPtr, char *internalPtr,
126     Tk_Window tkwin));
127     static Tcl_Obj * GetConfigList _ANSI_ARGS_((char *recordPtr,
128     Option *optionPtr, Tk_Window tkwin));
129     static Tcl_Obj * GetObjectForOption _ANSI_ARGS_((char *recordPtr,
130     Option *optionPtr, Tk_Window tkwin));
131     static Option * GetOptionFromObj _ANSI_ARGS_((Tcl_Interp *interp,
132     Tcl_Obj *objPtr, OptionTable *tablePtr));
133     static int ObjectIsEmpty _ANSI_ARGS_((Tcl_Obj *objPtr));
134     static int SetOptionFromAny _ANSI_ARGS_((Tcl_Interp *interp,
135     Tcl_Obj *objPtr));
136    
137     /*
138     * The structure below defines an object type that is used to cache the
139     * result of looking up an option name. If an object has this type, then
140     * its internalPtr1 field points to the OptionTable in which it was looked up,
141     * and the internalPtr2 field points to the entry that matched.
142     */
143    
144     Tcl_ObjType optionType = {
145     "option", /* name */
146     (Tcl_FreeInternalRepProc *) NULL, /* freeIntRepProc */
147     (Tcl_DupInternalRepProc *) NULL, /* dupIntRepProc */
148     (Tcl_UpdateStringProc *) NULL, /* updateStringProc */
149     SetOptionFromAny /* setFromAnyProc */
150     };
151    
152     /*
153     *--------------------------------------------------------------
154     *
155     * Tk_CreateOptionTable --
156     *
157     * Given a template for configuration options, this procedure
158     * creates a table that may be used to look up options efficiently.
159     *
160     * Results:
161     * Returns a token to a structure that can be passed to procedures
162     * such as Tk_InitOptions, Tk_SetOptions, and Tk_FreeConfigOptions.
163     *
164     * Side effects:
165     * Storage is allocated.
166     *
167     *--------------------------------------------------------------
168     */
169    
170     Tk_OptionTable
171     Tk_CreateOptionTable(interp, templatePtr)
172     Tcl_Interp *interp; /* Interpreter associated with the
173     * application in which this table
174     * will be used. */
175     CONST Tk_OptionSpec *templatePtr; /* Static information about the
176     * configuration options. */
177     {
178     Tcl_HashTable *hashTablePtr;
179     Tcl_HashEntry *hashEntryPtr;
180     int newEntry;
181     OptionTable *tablePtr;
182     CONST Tk_OptionSpec *specPtr, *specPtr2;
183     Option *optionPtr;
184     int numOptions, i;
185    
186     /*
187     * We use an AssocData value in the interpreter to keep a hash
188     * table of all the option tables we've created for this application.
189     * This is used for two purposes. First, it allows us to share the
190     * tables (e.g. in several chains) and second, we use the deletion
191     * callback for the AssocData to delete all the option tables when
192     * the interpreter is deleted. The code below finds the hash table
193     * or creates a new one if it doesn't already exist.
194     */
195    
196     hashTablePtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, OPTION_HASH_KEY,
197     NULL);
198     if (hashTablePtr == NULL) {
199     hashTablePtr = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
200     Tcl_InitHashTable(hashTablePtr, TCL_ONE_WORD_KEYS);
201     Tcl_SetAssocData(interp, OPTION_HASH_KEY, DestroyOptionHashTable,
202     (ClientData) hashTablePtr);
203     }
204    
205     /*
206     * See if a table has already been created for this template. If
207     * so, just reuse the existing table.
208     */
209    
210     hashEntryPtr = Tcl_CreateHashEntry(hashTablePtr, (char *) templatePtr,
211     &newEntry);
212     if (!newEntry) {
213     tablePtr = (OptionTable *) Tcl_GetHashValue(hashEntryPtr);
214     tablePtr->refCount++;
215     return (Tk_OptionTable) tablePtr;
216     }
217    
218     /*
219     * Count the number of options in the template, then create the
220     * table structure.
221     */
222    
223     numOptions = 0;
224     for (specPtr = templatePtr; specPtr->type != TK_OPTION_END; specPtr++) {
225     numOptions++;
226     }
227     tablePtr = (OptionTable *) (ckalloc(sizeof(OptionTable)
228     + ((numOptions - 1) * sizeof(Option))));
229     tablePtr->refCount = 1;
230     tablePtr->hashEntryPtr = hashEntryPtr;
231     tablePtr->nextPtr = NULL;
232     tablePtr->numOptions = numOptions;
233    
234     /*
235     * Initialize all of the Option structures in the table.
236     */
237    
238     for (specPtr = templatePtr, optionPtr = tablePtr->options;
239     specPtr->type != TK_OPTION_END; specPtr++, optionPtr++) {
240     optionPtr->specPtr = specPtr;
241     optionPtr->dbNameUID = NULL;
242     optionPtr->dbClassUID = NULL;
243     optionPtr->defaultPtr = NULL;
244     optionPtr->extra.monoColorPtr = NULL;
245     optionPtr->flags = 0;
246    
247     if (specPtr->type == TK_OPTION_SYNONYM) {
248     /*
249     * This is a synonym option; find the master option that it
250     * refers to and create a pointer from the synonym to the
251     * master.
252     */
253    
254     for (specPtr2 = templatePtr, i = 0; ; specPtr2++, i++) {
255     if (specPtr2->type == TK_OPTION_END) {
256     panic("Tk_CreateOptionTable couldn't find synonym");
257     }
258     if (strcmp(specPtr2->optionName,
259     (char *) specPtr->clientData) == 0) {
260     optionPtr->extra.synonymPtr = tablePtr->options + i;
261     break;
262     }
263     }
264     } else {
265     if (specPtr->dbName != NULL) {
266     optionPtr->dbNameUID = Tk_GetUid(specPtr->dbName);
267     }
268     if (specPtr->dbClass != NULL) {
269     optionPtr->dbClassUID =
270     Tk_GetUid(specPtr->dbClass);
271     }
272     if (specPtr->defValue != NULL) {
273     optionPtr->defaultPtr =
274     Tcl_NewStringObj(specPtr->defValue, -1);
275     Tcl_IncrRefCount(optionPtr->defaultPtr);
276     }
277     if (((specPtr->type == TK_OPTION_COLOR)
278     || (specPtr->type == TK_OPTION_BORDER))
279     && (specPtr->clientData != NULL)) {
280     optionPtr->extra.monoColorPtr =
281     Tcl_NewStringObj((char *) specPtr->clientData, -1);
282     Tcl_IncrRefCount(optionPtr->extra.monoColorPtr);
283     }
284     }
285     if (((specPtr->type == TK_OPTION_STRING)
286     && (specPtr->internalOffset >= 0))
287     || (specPtr->type == TK_OPTION_COLOR)
288     || (specPtr->type == TK_OPTION_FONT)
289     || (specPtr->type == TK_OPTION_BITMAP)
290     || (specPtr->type == TK_OPTION_BORDER)
291     || (specPtr->type == TK_OPTION_CURSOR)) {
292     optionPtr->flags |= OPTION_NEEDS_FREEING;
293     }
294     }
295     tablePtr->hashEntryPtr = hashEntryPtr;
296     Tcl_SetHashValue(hashEntryPtr, tablePtr);
297    
298     /*
299     * Finally, check to see if this template chains to another template
300     * with additional options. If so, call ourselves recursively to
301     * create the next table(s).
302     */
303    
304     if (specPtr->clientData != NULL) {
305     tablePtr->nextPtr = (OptionTable *) Tk_CreateOptionTable(interp,
306     (Tk_OptionSpec *) specPtr->clientData);
307     }
308    
309     return (Tk_OptionTable) tablePtr;
310     }
311    
312     /*
313     *----------------------------------------------------------------------
314     *
315     * Tk_DeleteOptionTable --
316     *
317     * Called to release resources used by an option table when
318     * the table is no longer needed.
319     *
320     * Results:
321     * None.
322     *
323     * Side effects:
324     * The option table and associated resources (such as additional
325     * option tables chained off it) are destroyed.
326     *
327     *----------------------------------------------------------------------
328     */
329    
330     void
331     Tk_DeleteOptionTable(optionTable)
332     Tk_OptionTable optionTable; /* The option table to delete. */
333     {
334     OptionTable *tablePtr = (OptionTable *) optionTable;
335     Option *optionPtr;
336     int count;
337    
338     tablePtr->refCount--;
339     if (tablePtr->refCount > 0) {
340     return;
341     }
342    
343     if (tablePtr->nextPtr != NULL) {
344     Tk_DeleteOptionTable((Tk_OptionTable) tablePtr->nextPtr);
345     }
346    
347     for (count = tablePtr->numOptions - 1, optionPtr = tablePtr->options;
348     count > 0; count--, optionPtr++) {
349     if (optionPtr->defaultPtr != NULL) {
350     Tcl_DecrRefCount(optionPtr->defaultPtr);
351     }
352     if (((optionPtr->specPtr->type == TK_OPTION_COLOR)
353     || (optionPtr->specPtr->type == TK_OPTION_BORDER))
354     && (optionPtr->extra.monoColorPtr != NULL)) {
355     Tcl_DecrRefCount(optionPtr->extra.monoColorPtr);
356     }
357     }
358     Tcl_DeleteHashEntry(tablePtr->hashEntryPtr);
359     ckfree((char *) tablePtr);
360     }
361    
362     /*
363     *----------------------------------------------------------------------
364     *
365     * DestroyOptionHashTable --
366     *
367     * This procedure is the deletion callback associated with the
368     * AssocData entry created by Tk_CreateOptionTable. It is
369     * invoked when an interpreter is deleted, and deletes all of
370     * the option tables associated with that interpreter.
371     *
372     * Results:
373     * None.
374     *
375     * Side effects:
376     * The option hash table is destroyed along with all of the
377     * OptionTable structures that it refers to.
378     *
379     *----------------------------------------------------------------------
380     */
381    
382     static void
383     DestroyOptionHashTable(clientData, interp)
384     ClientData clientData; /* The hash table we are destroying */
385     Tcl_Interp *interp; /* The interpreter we are destroying */
386     {
387     Tcl_HashTable *hashTablePtr = (Tcl_HashTable *) clientData;
388     Tcl_HashSearch search;
389     Tcl_HashEntry *hashEntryPtr;
390     OptionTable *tablePtr;
391    
392     for (hashEntryPtr = Tcl_FirstHashEntry(hashTablePtr, &search);
393     hashEntryPtr != NULL;
394     hashEntryPtr = Tcl_NextHashEntry(&search)) {
395     tablePtr = (OptionTable *) Tcl_GetHashValue(hashEntryPtr);
396    
397     /*
398     * The following statements do two tricky things:
399     * 1. They ensure that the option table is deleted, even if
400     * there are outstanding references to it.
401     * 2. They ensure that Tk_DeleteOptionTable doesn't delete
402     * other tables chained from this one; we'll do it when
403     * we come across the hash table entry for the chained
404     * table (in fact, the chained table may already have
405     * been deleted).
406     */
407    
408     tablePtr->refCount = 1;
409     tablePtr->nextPtr = NULL;
410     Tk_DeleteOptionTable((Tk_OptionTable) tablePtr);
411     }
412     Tcl_DeleteHashTable(hashTablePtr);
413     ckfree((char *) hashTablePtr);
414     }
415    
416     /*
417     *--------------------------------------------------------------
418     *
419     * Tk_InitOptions --
420     *
421     * This procedure is invoked when an object such as a widget
422     * is created. It supplies an initial value for each configuration
423     * option (the value may come from the option database, a system
424     * default, or the default in the option table).
425     *
426     * Results:
427     * The return value is TCL_OK if the procedure completed
428     * successfully, and TCL_ERROR if one of the initial values was
429     * bogus. If an error occurs and interp isn't NULL, then an
430     * error message will be left in its result.
431     *
432     * Side effects:
433     * Fields of recordPtr are filled in with initial values.
434     *
435     *--------------------------------------------------------------
436     */
437    
438     int
439     Tk_InitOptions(interp, recordPtr, optionTable, tkwin)
440     Tcl_Interp *interp; /* Interpreter for error reporting. NULL
441     * means don't leave an error message. */
442     char *recordPtr; /* Pointer to the record to configure.
443     * Note: the caller should have properly
444     * initialized the record with NULL
445     * pointers for each option value. */
446     Tk_OptionTable optionTable; /* The token which matches the config
447     * specs for the widget in question. */
448     Tk_Window tkwin; /* Certain options types (such as
449     * TK_OPTION_COLOR) need fields out
450     * of the window they are used in to
451     * be able to calculate their values.
452     * Not needed unless one of these
453     * options is in the configSpecs record. */
454     {
455     OptionTable *tablePtr = (OptionTable *) optionTable;
456     Option *optionPtr;
457     int count;
458     char *value;
459     Tcl_Obj *valuePtr;
460     enum {
461     OPTION_DATABASE, SYSTEM_DEFAULT, TABLE_DEFAULT
462     } source;
463    
464     /*
465     * If this table chains to other tables, handle their initialization
466     * first. That way, if both tables refer to the same field of the
467     * record, the value in the first table will win.
468     */
469    
470     if (tablePtr->nextPtr != NULL) {
471     if (Tk_InitOptions(interp, recordPtr,
472     (Tk_OptionTable) tablePtr->nextPtr, tkwin) != TCL_OK) {
473     return TCL_ERROR;
474     }
475     }
476    
477     /*
478     * Iterate over all of the options in the table, initializing each in
479     * turn.
480     */
481    
482     for (optionPtr = tablePtr->options, count = tablePtr->numOptions;
483     count > 0; optionPtr++, count--) {
484    
485     /*
486     * If we specify TK_OPTION_DONT_SET_DEFAULT, then the user has
487     * processed and set a default for this already.
488     */
489     if ((optionPtr->specPtr->type == TK_OPTION_SYNONYM) ||
490     (optionPtr->specPtr->flags & TK_OPTION_DONT_SET_DEFAULT)) {
491     continue;
492     }
493     source = TABLE_DEFAULT;
494    
495     /*
496     * We look in three places for the initial value, using the first
497     * non-NULL value that we find. First, check the option database.
498     */
499    
500     valuePtr = NULL;
501     if (optionPtr->dbNameUID != NULL) {
502     value = Tk_GetOption(tkwin, optionPtr->dbNameUID,
503     optionPtr->dbClassUID);
504     if (value != NULL) {
505     valuePtr = Tcl_NewStringObj(value, -1);
506     source = OPTION_DATABASE;
507     }
508     }
509    
510     /*
511     * Second, check for a system-specific default value.
512     */
513     if ((valuePtr == NULL)
514     && (optionPtr->dbNameUID != NULL)) {
515     valuePtr = TkpGetSystemDefault(tkwin, optionPtr->dbNameUID,
516     optionPtr->dbClassUID);
517     if (valuePtr != NULL) {
518     source = SYSTEM_DEFAULT;
519     }
520     }
521    
522     /*
523     * Third and last, use the default value supplied by the option
524     * table. In the case of color objects, we pick one of two
525     * values depending on whether the screen is mono or color.
526     */
527    
528     if (valuePtr == NULL) {
529     if ((tkwin != NULL)
530     && ((optionPtr->specPtr->type == TK_OPTION_COLOR)
531     || (optionPtr->specPtr->type == TK_OPTION_BORDER))
532     && (Tk_Depth(tkwin) <= 1)
533     && (optionPtr->extra.monoColorPtr != NULL)) {
534     valuePtr = optionPtr->extra.monoColorPtr;
535     } else {
536     valuePtr = optionPtr->defaultPtr;
537     }
538     }
539    
540     if (valuePtr == NULL) {
541     continue;
542     }
543    
544     if (DoObjConfig(interp, recordPtr, optionPtr, valuePtr, tkwin,
545     (Tk_SavedOption *) NULL) != TCL_OK) {
546     if (interp != NULL) {
547     char msg[200];
548    
549     switch (source) {
550     case OPTION_DATABASE:
551     sprintf(msg, "\n (database entry for \"%.50s\")",
552     optionPtr->specPtr->optionName);
553     break;
554     case SYSTEM_DEFAULT:
555     sprintf(msg, "\n (system default for \"%.50s\")",
556     optionPtr->specPtr->optionName);
557     break;
558     case TABLE_DEFAULT:
559     sprintf(msg, "\n (default value for \"%.50s\")",
560     optionPtr->specPtr->optionName);
561     }
562     if (tkwin != NULL) {
563     sprintf(msg + strlen(msg) - 1, " in widget \"%.50s\")",
564     Tk_PathName(tkwin));
565     }
566     Tcl_AddErrorInfo(interp, msg);
567     }
568     return TCL_ERROR;
569     }
570     }
571     return TCL_OK;
572     }
573    
574     /*
575     *--------------------------------------------------------------
576     *
577     * DoObjConfig --
578     *
579     * This procedure applies a new value for a configuration option
580     * to the record being configured.
581     *
582     * Results:
583     * The return value is TCL_OK if the procedure completed
584     * successfully. If an error occurred then TCL_ERROR is
585     * returned and an error message is left in interp's result, if
586     * interp isn't NULL. In addition, if oldValuePtrPtr isn't
587     * NULL then it *oldValuePtrPtr is filled in with a pointer
588     * to the option's old value.
589     *
590     * Side effects:
591     * RecordPtr gets modified to hold the new value in the form of
592     * a Tcl_Obj, an internal representation, or both. The old
593     * value is freed if oldValuePtrPtr is NULL.
594     *
595     *--------------------------------------------------------------
596     */
597    
598     static int
599     DoObjConfig(interp, recordPtr, optionPtr, valuePtr, tkwin, savedOptionPtr)
600     Tcl_Interp *interp; /* Interpreter for error reporting. If
601     * NULL, then no message is left if an error
602     * occurs. */
603     char *recordPtr; /* The record to modify to hold the new
604     * option value. */
605     Option *optionPtr; /* Pointer to information about the
606     * option. */
607     Tcl_Obj *valuePtr; /* New value for option. */
608     Tk_Window tkwin; /* Window in which option will be used (needed
609     * to allocate resources for some options).
610     * May be NULL if the option doesn't
611     * require window-related resources. */
612     Tk_SavedOption *savedOptionPtr;
613     /* If NULL, the old value for the option will
614     * be freed. If non-NULL, the old value will
615     * be stored here, and it becomes the property
616     * of the caller (the caller must eventually
617     * free the old value). */
618     {
619     Tcl_Obj **slotPtrPtr, *oldPtr;
620     char *internalPtr; /* Points to location in record where
621     * internal representation of value should
622     * be stored, or NULL. */
623     char *oldInternalPtr; /* Points to location in which to save old
624     * internal representation of value. */
625     Tk_SavedOption internal; /* Used to save the old internal representation
626     * of the value if savedOptionPtr is NULL. */
627     CONST Tk_OptionSpec *specPtr;
628     int nullOK;
629    
630     /*
631     * Save the old object form for the value, if there is one.
632     */
633    
634     specPtr = optionPtr->specPtr;
635     if (specPtr->objOffset >= 0) {
636     slotPtrPtr = (Tcl_Obj **) (recordPtr + specPtr->objOffset);
637     oldPtr = *slotPtrPtr;
638     } else {
639     slotPtrPtr = NULL;
640     oldPtr = NULL;
641     }
642    
643     /*
644     * Apply the new value in a type-specific way. Also remember the
645     * old object and internal forms, if they exist.
646     */
647    
648     if (specPtr->internalOffset >= 0) {
649     internalPtr = recordPtr + specPtr->internalOffset;
650     } else {
651     internalPtr = NULL;
652     }
653     if (savedOptionPtr != NULL) {
654     savedOptionPtr->optionPtr = optionPtr;
655     savedOptionPtr->valuePtr = oldPtr;
656     oldInternalPtr = (char *) &savedOptionPtr->internalForm;
657     } else {
658     oldInternalPtr = (char *) &internal.internalForm;
659     }
660     nullOK = (optionPtr->specPtr->flags & TK_OPTION_NULL_OK);
661     switch (optionPtr->specPtr->type) {
662     case TK_OPTION_BOOLEAN: {
663     int new;
664    
665     if (Tcl_GetBooleanFromObj(interp, valuePtr, &new)
666     != TCL_OK) {
667     return TCL_ERROR;
668     }
669     if (internalPtr != NULL) {
670     *((int *) oldInternalPtr) = *((int *) internalPtr);
671     *((int *) internalPtr) = new;
672     }
673     break;
674     }
675     case TK_OPTION_INT: {
676     int new;
677    
678     if (Tcl_GetIntFromObj(interp, valuePtr, &new) != TCL_OK) {
679     return TCL_ERROR;
680     }
681     if (internalPtr != NULL) {
682     *((int *) oldInternalPtr) = *((int *) internalPtr);
683     *((int *) internalPtr) = new;
684     }
685     break;
686     }
687     case TK_OPTION_DOUBLE: {
688     double new;
689    
690     if (Tcl_GetDoubleFromObj(interp, valuePtr, &new)
691     != TCL_OK) {
692     return TCL_ERROR;
693     }
694     if (internalPtr != NULL) {
695     *((double *) oldInternalPtr) = *((double *) internalPtr);
696     *((double *) internalPtr) = new;
697     }
698     break;
699     }
700     case TK_OPTION_STRING: {
701     char *new, *value;
702     int length;
703    
704     if (nullOK && ObjectIsEmpty(valuePtr)) {
705     valuePtr = NULL;
706     }
707     if (internalPtr != NULL) {
708     if (valuePtr != NULL) {
709     value = Tcl_GetStringFromObj(valuePtr, &length);
710     new = ckalloc((unsigned) (length + 1));
711     strcpy(new, value);
712     } else {
713     new = NULL;
714     }
715     *((char **) oldInternalPtr) = *((char **) internalPtr);
716     *((char **) internalPtr) = new;
717     }
718     break;
719     }
720     case TK_OPTION_STRING_TABLE: {
721     int new;
722    
723     if (Tcl_GetIndexFromObj(interp, valuePtr,
724     (char **) optionPtr->specPtr->clientData,
725     optionPtr->specPtr->optionName+1, 0, &new) != TCL_OK) {
726     return TCL_ERROR;
727     }
728     if (internalPtr != NULL) {
729     *((int *) oldInternalPtr) = *((int *) internalPtr);
730     *((int *) internalPtr) = new;
731     }
732     break;
733     }
734     case TK_OPTION_COLOR: {
735     XColor *newPtr;
736    
737     if (nullOK && ObjectIsEmpty(valuePtr)) {
738     valuePtr = NULL;
739     newPtr = NULL;
740     } else {
741     newPtr = Tk_AllocColorFromObj(interp, tkwin, valuePtr);
742     if (newPtr == NULL) {
743     return TCL_ERROR;
744     }
745     }
746     if (internalPtr != NULL) {
747     *((XColor **) oldInternalPtr) = *((XColor **) internalPtr);
748     *((XColor **) internalPtr) = newPtr;
749     }
750     break;
751     }
752     case TK_OPTION_FONT: {
753     Tk_Font new;
754    
755     if (nullOK && ObjectIsEmpty(valuePtr)) {
756     valuePtr = NULL;
757     new = NULL;
758     } else {
759     new = Tk_AllocFontFromObj(interp, tkwin, valuePtr);
760     if (new == NULL) {
761     return TCL_ERROR;
762     }
763     }
764     if (internalPtr != NULL) {
765     *((Tk_Font *) oldInternalPtr) = *((Tk_Font *) internalPtr);
766     *((Tk_Font *) internalPtr) = new;
767     }
768     break;
769     }
770     case TK_OPTION_BITMAP: {
771     Pixmap new;
772    
773     if (nullOK && ObjectIsEmpty(valuePtr)) {
774     valuePtr = NULL;
775     new = None;
776     } else {
777     new = Tk_AllocBitmapFromObj(interp, tkwin, valuePtr);
778     if (new == None) {
779     return TCL_ERROR;
780     }
781     }
782     if (internalPtr != NULL) {
783     *((Pixmap *) oldInternalPtr) = *((Pixmap *) internalPtr);
784     *((Pixmap *) internalPtr) = new;
785     }
786     break;
787     }
788     case TK_OPTION_BORDER: {
789     Tk_3DBorder new;
790    
791     if (nullOK && ObjectIsEmpty(valuePtr)) {
792     valuePtr = NULL;
793     new = NULL;
794     } else {
795     new = Tk_Alloc3DBorderFromObj(interp, tkwin, valuePtr);
796     if (new == NULL) {
797     return TCL_ERROR;
798     }
799     }
800     if (internalPtr != NULL) {
801     *((Tk_3DBorder *) oldInternalPtr) =
802     *((Tk_3DBorder *) internalPtr);
803     *((Tk_3DBorder *) internalPtr) = new;
804     }
805     break;
806     }
807     case TK_OPTION_RELIEF: {
808     int new;
809    
810     if (Tk_GetReliefFromObj(interp, valuePtr, &new) != TCL_OK) {
811     return TCL_ERROR;
812     }
813     if (internalPtr != NULL) {
814     *((int *) oldInternalPtr) = *((int *) internalPtr);
815     *((int *) internalPtr) = new;
816     }
817     break;
818     }
819     case TK_OPTION_CURSOR: {
820     Tk_Cursor new;
821    
822     if (nullOK && ObjectIsEmpty(valuePtr)) {
823     new = None;
824     valuePtr = NULL;
825     } else {
826     new = Tk_AllocCursorFromObj(interp, tkwin, valuePtr);
827     if (new == None) {
828     return TCL_ERROR;
829     }
830     }
831     if (internalPtr != NULL) {
832     *((Tk_Cursor *) oldInternalPtr) = *((Tk_Cursor *) internalPtr);
833     *((Tk_Cursor *) internalPtr) = new;
834     }
835     Tk_DefineCursor(tkwin, new);
836     break;
837     }
838     case TK_OPTION_JUSTIFY: {
839     Tk_Justify new;
840    
841     if (Tk_GetJustifyFromObj(interp, valuePtr, &new) != TCL_OK) {
842     return TCL_ERROR;
843     }
844     if (internalPtr != NULL) {
845     *((Tk_Justify *) oldInternalPtr)
846     = *((Tk_Justify *) internalPtr);
847     *((Tk_Justify *) internalPtr) = new;
848     }
849     break;
850     }
851     case TK_OPTION_ANCHOR: {
852     Tk_Anchor new;
853    
854     if (Tk_GetAnchorFromObj(interp, valuePtr, &new) != TCL_OK) {
855     return TCL_ERROR;
856     }
857     if (internalPtr != NULL) {
858     *((Tk_Anchor *) oldInternalPtr)
859     = *((Tk_Anchor *) internalPtr);
860     *((Tk_Anchor *) internalPtr) = new;
861     }
862     break;
863     }
864     case TK_OPTION_PIXELS: {
865     int new;
866    
867     if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr,
868     &new) != TCL_OK) {
869     return TCL_ERROR;
870     }
871     if (internalPtr != NULL) {
872     *((int *) oldInternalPtr) = *((int *) internalPtr);
873     *((int *) internalPtr) = new;
874     }
875     break;
876     }
877     case TK_OPTION_WINDOW: {
878     Tk_Window new;
879    
880     if (nullOK && ObjectIsEmpty(valuePtr)) {
881     valuePtr = NULL;
882     new = None;
883     } else {
884     if (TkGetWindowFromObj(interp, tkwin, valuePtr, &new)
885     != TCL_OK) {
886     return TCL_ERROR;
887     }
888     }
889     if (internalPtr != NULL) {
890     *((Tk_Window *) oldInternalPtr) = *((Tk_Window *) internalPtr);
891     *((Tk_Window *) internalPtr) = new;
892     }
893     break;
894     }
895     default: {
896     char buf[40+TCL_INTEGER_SPACE];
897     sprintf(buf, "bad config table: unknown type %d",
898     optionPtr->specPtr->type);
899     Tcl_SetResult(interp, buf, TCL_VOLATILE);
900     return TCL_ERROR;
901     }
902     }
903    
904     /*
905     * Release resources associated with the old value, if we're not
906     * returning it to the caller, then install the new object value into
907     * the record.
908     */
909    
910     if (savedOptionPtr == NULL) {
911     if (optionPtr->flags & OPTION_NEEDS_FREEING) {
912     FreeResources(optionPtr, oldPtr, oldInternalPtr, tkwin);
913     }
914     if (oldPtr != NULL) {
915     Tcl_DecrRefCount(oldPtr);
916     }
917     }
918     if (slotPtrPtr != NULL) {
919     *slotPtrPtr = valuePtr;
920     if (valuePtr != NULL) {
921     Tcl_IncrRefCount(valuePtr);
922     }
923     }
924     return TCL_OK;
925     }
926    
927     /*
928     *----------------------------------------------------------------------
929     *
930     * ObjectIsEmpty --
931     *
932     * This procedure tests whether the string value of an object is
933     * empty.
934     *
935     * Results:
936     * The return value is 1 if the string value of objPtr has length
937     * zero, and 0 otherwise.
938     *
939     * Side effects:
940     * None.
941     *
942     *----------------------------------------------------------------------
943     */
944    
945     static int
946     ObjectIsEmpty(objPtr)
947     Tcl_Obj *objPtr; /* Object to test. May be NULL. */
948     {
949     int length;
950    
951     if (objPtr == NULL) {
952     return 1;
953     }
954     if (objPtr->bytes != NULL) {
955     return (objPtr->length == 0);
956     }
957     Tcl_GetStringFromObj(objPtr, &length);
958     return (length == 0);
959     }
960    
961     /*
962     *----------------------------------------------------------------------
963     *
964     * GetOptionFromObj --
965     *
966     * This procedure searches through a chained option table to find
967     * the entry for a particular option name.
968     *
969     * Results:
970     * The return value is a pointer to the matching entry, or NULL
971     * if no matching entry could be found. If NULL is returned and
972     * interp is not NULL than an error message is left in its result.
973     * Note: if the matching entry is a synonym then this procedure
974     * returns a pointer to the synonym entry, *not* the "real" entry
975     * that the synonym refers to.
976     *
977     * Side effects:
978     * Information about the matching entry is cached in the object
979     * containing the name, so that future lookups can proceed more
980     * quickly.
981     *
982     *----------------------------------------------------------------------
983     */
984    
985     static Option *
986     GetOptionFromObj(interp, objPtr, tablePtr)
987     Tcl_Interp *interp; /* Used only for error reporting; if NULL
988     * no message is left after an error. */
989     Tcl_Obj *objPtr; /* Object whose string value is to be
990     * looked up in the option table. */
991     OptionTable *tablePtr; /* Table in which to look up objPtr. */
992     {
993     Option *bestPtr, *optionPtr;
994     OptionTable *tablePtr2;
995     char *p1, *p2, *name;
996     int count;
997    
998     /*
999     * First, check to see if the object already has the answer cached.
1000     */
1001    
1002     if (objPtr->typePtr == &optionType) {
1003     if (objPtr->internalRep.twoPtrValue.ptr1 == (VOID *) tablePtr) {
1004     return (Option *) objPtr->internalRep.twoPtrValue.ptr2;
1005     }
1006     }
1007    
1008     /*
1009     * The answer isn't cached. Search through all of the option tables
1010     * in the chain to find the best match. Some tricky aspects:
1011     *
1012     * 1. We have to accept unique abbreviations.
1013     * 2. The same name could appear in different tables in the chain.
1014     * If this happens, we use the entry from the first table. We
1015     * have to be careful to distinguish this case from an ambiguous
1016     * abbreviation.
1017     */
1018    
1019     bestPtr = NULL;
1020     name = Tcl_GetStringFromObj(objPtr, (int *) NULL);
1021     for (tablePtr2 = tablePtr; tablePtr2 != NULL;
1022     tablePtr2 = tablePtr2->nextPtr) {
1023     for (optionPtr = tablePtr2->options, count = tablePtr2->numOptions;
1024     count > 0; optionPtr++, count--) {
1025     for (p1 = name, p2 = optionPtr->specPtr->optionName;
1026     *p1 == *p2; p1++, p2++) {
1027     if (*p1 == 0) {
1028     /*
1029     * This is an exact match. We're done.
1030     */
1031    
1032     bestPtr = optionPtr;
1033     goto done;
1034     }
1035     }
1036     if (*p1 == 0) {
1037     /*
1038     * The name is an abbreviation for this option. Keep
1039     * to make sure that the abbreviation only matches one
1040     * option name. If we've already found a match in the
1041     * past, then it is an error unless the full names for
1042     * the two options are identical; in this case, the first
1043     * option overrides the second.
1044     */
1045    
1046     if (bestPtr == NULL) {
1047     bestPtr = optionPtr;
1048     } else {
1049     if (strcmp(bestPtr->specPtr->optionName,
1050     optionPtr->specPtr->optionName) != 0) {
1051     goto error;
1052     }
1053     }
1054     }
1055     }
1056     }
1057     if (bestPtr == NULL) {
1058     goto error;
1059     }
1060    
1061     done:
1062     if ((objPtr->typePtr != NULL)
1063     && (objPtr->typePtr->freeIntRepProc != NULL)) {
1064     objPtr->typePtr->freeIntRepProc(objPtr);
1065     }
1066     objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) tablePtr;
1067     objPtr->internalRep.twoPtrValue.ptr2 = (VOID *) bestPtr;
1068     objPtr->typePtr = &optionType;
1069     return bestPtr;
1070    
1071     error:
1072     if (interp != NULL) {
1073     Tcl_AppendResult(interp, "unknown option \"", name,
1074     "\"", (char *) NULL);
1075     }
1076     return NULL;
1077     }
1078    
1079     /*
1080     *----------------------------------------------------------------------
1081     *
1082     * SetOptionFromAny --
1083     *
1084     * This procedure is called to convert a Tcl object to option
1085     * internal form. However, this doesn't make sense (need to have a
1086     * table of options in order to do the conversion) so the
1087     * procedure always generates an error.
1088     *
1089     * Results:
1090     * The return value is always TCL_ERROR, and an error message is
1091     * left in interp's result if interp isn't NULL.
1092     *
1093     * Side effects:
1094     * None.
1095     *
1096     *----------------------------------------------------------------------
1097     */
1098    
1099     static int
1100     SetOptionFromAny(interp, objPtr)
1101     Tcl_Interp *interp; /* Used for error reporting if not NULL. */
1102     register Tcl_Obj *objPtr; /* The object to convert. */
1103     {
1104     Tcl_AppendToObj(Tcl_GetObjResult(interp),
1105     "can't convert value to option except via GetOptionFromObj API",
1106     -1);
1107     return TCL_ERROR;
1108     }
1109    
1110     /*
1111     *--------------------------------------------------------------
1112     *
1113     * Tk_SetOptions --
1114     *
1115     * Process one or more name-value pairs for configuration options
1116     * and fill in fields of a record with new values.
1117     *
1118     * Results:
1119     * If all goes well then TCL_OK is returned and the old values of
1120     * any modified objects are saved in *savePtr, if it isn't NULL (the
1121     * caller must eventually call Tk_RestoreSavedOptions or
1122     * Tk_FreeSavedOptions to free the contents of *savePtr). In
1123     * addition, if maskPtr isn't NULL then *maskPtr is filled in with
1124     * the OR of the typeMask bits from all modified options. If an
1125     * error occurs then TCL_ERROR is returned and a message
1126     * is left in interp's result unless interp is NULL; nothing is
1127     * saved in *savePtr or *maskPtr in this case.
1128     *
1129     * Side effects:
1130     * The fields of recordPtr get filled in with object pointers
1131     * from objc/objv. Old information in widgRec's fields gets
1132     * recycled. Information may be left at *savePtr.
1133     *
1134     *--------------------------------------------------------------
1135     */
1136    
1137     int
1138     Tk_SetOptions(interp, recordPtr, optionTable, objc, objv, tkwin, savePtr,
1139     maskPtr)
1140     Tcl_Interp *interp; /* Interpreter for error reporting.
1141     * If NULL, then no error message is
1142     * returned.*/
1143     char *recordPtr; /* The record to configure. */
1144     Tk_OptionTable optionTable; /* Describes valid options. */
1145     int objc; /* The number of elements in objv. */
1146     Tcl_Obj *CONST objv[]; /* Contains one or more name-value
1147     * pairs. */
1148     Tk_Window tkwin; /* Window associated with the thing
1149     * being configured; needed for some
1150     * options (such as colors). */
1151     Tk_SavedOptions *savePtr; /* If non-NULL, the old values of
1152     * modified options are saved here
1153     * so that they can be restored
1154     * after an error. */
1155     int *maskPtr; /* It non-NULL, this word is modified
1156     * on a successful return to hold the
1157     * bit-wise OR of the typeMask fields
1158     * of all options that were modified
1159     * by this call. Used by the caller
1160     * to figure out which options
1161     * actually changed. */
1162     {
1163     OptionTable *tablePtr = (OptionTable *) optionTable;
1164     Option *optionPtr;
1165     Tk_SavedOptions *lastSavePtr, *newSavePtr;
1166     int mask;
1167    
1168     if (savePtr != NULL) {
1169     savePtr->recordPtr = recordPtr;
1170     savePtr->tkwin = tkwin;
1171     savePtr->numItems = 0;
1172     savePtr->nextPtr = NULL;
1173     }
1174     lastSavePtr = savePtr;
1175    
1176     /*
1177     * Scan through all of the arguments, processing those
1178     * that match entries in the option table.
1179     */
1180    
1181     mask = 0;
1182     for ( ; objc > 0; objc -= 2, objv += 2) {
1183     optionPtr = GetOptionFromObj(interp, objv[0], tablePtr);
1184     if (optionPtr == NULL) {
1185     goto error;
1186     }
1187     if (optionPtr->specPtr->type == TK_OPTION_SYNONYM) {
1188     optionPtr = optionPtr->extra.synonymPtr;
1189     }
1190    
1191     if (objc < 2) {
1192     if (interp != NULL) {
1193     Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
1194     "value for \"", Tcl_GetStringFromObj(*objv, NULL),
1195     "\" missing", (char *) NULL);
1196     goto error;
1197     }
1198     }
1199     if ((savePtr != NULL)
1200     && (lastSavePtr->numItems >= TK_NUM_SAVED_OPTIONS)) {
1201     /*
1202     * We've run out of space for saving old option values. Allocate
1203     * more space.
1204     */
1205    
1206     newSavePtr = (Tk_SavedOptions *) ckalloc(sizeof(
1207     Tk_SavedOptions));
1208     newSavePtr->recordPtr = recordPtr;
1209     newSavePtr->tkwin = tkwin;
1210     newSavePtr->numItems = 0;
1211     newSavePtr->nextPtr = NULL;
1212     lastSavePtr->nextPtr = newSavePtr;
1213     lastSavePtr = newSavePtr;
1214     }
1215     if (DoObjConfig(interp, recordPtr, optionPtr, objv[1], tkwin,
1216     (savePtr != NULL) ? &lastSavePtr->items[lastSavePtr->numItems]
1217     : (Tk_SavedOption *) NULL) != TCL_OK) {
1218     char msg[100];
1219    
1220     sprintf(msg, "\n (processing \"%.40s\" option)",
1221     Tcl_GetStringFromObj(*objv, NULL));
1222     Tcl_AddErrorInfo(interp, msg);
1223     goto error;
1224     }
1225     if (savePtr != NULL) {
1226     lastSavePtr->numItems++;
1227     }
1228     mask |= optionPtr->specPtr->typeMask;
1229     }
1230     if (maskPtr != NULL) {
1231     *maskPtr = mask;
1232     }
1233     return TCL_OK;
1234    
1235     error:
1236     if (savePtr != NULL) {
1237     Tk_RestoreSavedOptions(savePtr);
1238     }
1239     return TCL_ERROR;
1240     }
1241    
1242     /*
1243     *----------------------------------------------------------------------
1244     *
1245     * Tk_RestoreSavedOptions --
1246     *
1247     * This procedure undoes the effect of a previous call to
1248     * Tk_SetOptions by restoring all of the options to their value
1249     * before the call to Tk_SetOptions.
1250     *
1251     * Results:
1252     * None.
1253     *
1254     * Side effects:
1255     * The configutation record is restored and all the information
1256     * stored in savePtr is freed.
1257     *
1258     *----------------------------------------------------------------------
1259     */
1260    
1261     void
1262     Tk_RestoreSavedOptions(savePtr)
1263     Tk_SavedOptions *savePtr; /* Holds saved option information; must
1264     * have been passed to Tk_SetOptions. */
1265     {
1266     int i;
1267     Option *optionPtr;
1268     Tcl_Obj *newPtr; /* New object value of option, which we
1269     * replace with old value and free. Taken
1270     * from record. */
1271     char *internalPtr; /* Points to internal value of option in
1272     * record. */
1273     CONST Tk_OptionSpec *specPtr;
1274    
1275     /*
1276     * Be sure to restore the options in the opposite order they were
1277     * set. This is important because it's possible that the same
1278     * option name was used twice in a single call to Tk_SetOptions.
1279     */
1280    
1281     if (savePtr->nextPtr != NULL) {
1282     Tk_RestoreSavedOptions(savePtr->nextPtr);
1283     ckfree((char *) savePtr->nextPtr);
1284     savePtr->nextPtr = NULL;
1285     }
1286     for (i = savePtr->numItems - 1; i >= 0; i--) {
1287     optionPtr = savePtr->items[i].optionPtr;
1288     specPtr = optionPtr->specPtr;
1289    
1290     /*
1291     * First free the new value of the option, which is currently
1292     * in the record.
1293     */
1294    
1295     if (specPtr->objOffset >= 0) {
1296     newPtr = *((Tcl_Obj **) (savePtr->recordPtr + specPtr->objOffset));
1297     } else {
1298     newPtr = NULL;
1299     }
1300     if (specPtr->internalOffset >= 0) {
1301     internalPtr = savePtr->recordPtr + specPtr->internalOffset;
1302     } else {
1303     internalPtr = NULL;
1304     }
1305     if (optionPtr->flags & OPTION_NEEDS_FREEING) {
1306     FreeResources(optionPtr, newPtr, internalPtr, savePtr->tkwin);
1307     }
1308     if (newPtr != NULL) {
1309     Tcl_DecrRefCount(newPtr);
1310     }
1311    
1312     /*
1313     * Now restore the old value of the option.
1314     */
1315    
1316     if (specPtr->objOffset >= 0) {
1317     *((Tcl_Obj **) (savePtr->recordPtr + specPtr->objOffset))
1318     = savePtr->items[i].valuePtr;
1319     }
1320     if (specPtr->internalOffset >= 0) {
1321     switch (specPtr->type) {
1322     case TK_OPTION_BOOLEAN: {
1323     *((int *) internalPtr)
1324     = *((int *) &savePtr->items[i].internalForm);
1325     break;
1326     }
1327     case TK_OPTION_INT: {
1328     *((int *) internalPtr)
1329     = *((int *) &savePtr->items[i].internalForm);
1330     break;
1331     }
1332     case TK_OPTION_DOUBLE: {
1333     *((double *) internalPtr)
1334     = *((double *) &savePtr->items[i].internalForm);
1335     break;
1336     }
1337     case TK_OPTION_STRING: {
1338     *((char **) internalPtr)
1339     = *((char **) &savePtr->items[i].internalForm);
1340     break;
1341     }
1342     case TK_OPTION_STRING_TABLE: {
1343     *((int *) internalPtr)
1344     = *((int *) &savePtr->items[i].internalForm);
1345     break;
1346     }
1347     case TK_OPTION_COLOR: {
1348     *((XColor **) internalPtr)
1349     = *((XColor **) &savePtr->items[i].internalForm);
1350     break;
1351     }
1352     case TK_OPTION_FONT: {
1353     *((Tk_Font *) internalPtr)
1354     = *((Tk_Font *) &savePtr->items[i].internalForm);
1355     break;
1356     }
1357     case TK_OPTION_BITMAP: {
1358     *((Pixmap *) internalPtr)
1359     = *((Pixmap *) &savePtr->items[i].internalForm);
1360     break;
1361     }
1362     case TK_OPTION_BORDER: {
1363     *((Tk_3DBorder *) internalPtr)
1364     = *((Tk_3DBorder *) &savePtr->items[i].internalForm);
1365     break;
1366     }
1367     case TK_OPTION_RELIEF: {
1368     *((int *) internalPtr)
1369     = *((int *) &savePtr->items[i].internalForm);
1370     break;
1371     }
1372     case TK_OPTION_CURSOR: {
1373     *((Tk_Cursor *) internalPtr)
1374     = *((Tk_Cursor *) &savePtr->items[i].internalForm);
1375     Tk_DefineCursor(savePtr->tkwin,
1376     *((Tk_Cursor *) internalPtr));
1377     break;
1378     }
1379     case TK_OPTION_JUSTIFY: {
1380     *((Tk_Justify *) internalPtr)
1381     = *((Tk_Justify *) &savePtr->items[i].internalForm);
1382     break;
1383     }
1384     case TK_OPTION_ANCHOR: {
1385     *((Tk_Anchor *) internalPtr)
1386     = *((Tk_Anchor *) &savePtr->items[i].internalForm);
1387     break;
1388     }
1389     case TK_OPTION_PIXELS: {
1390     *((int *) internalPtr)
1391     = *((int *) &savePtr->items[i].internalForm);
1392     break;
1393     }
1394     case TK_OPTION_WINDOW: {
1395     *((Tk_Window *) internalPtr)
1396     = *((Tk_Window *) &savePtr->items[i].internalForm);
1397     break;
1398     }
1399     default: {
1400     panic("bad option type in Tk_RestoreSavedOptions");
1401     }
1402     }
1403     }
1404     }
1405     savePtr->numItems = 0;
1406     }
1407    
1408     /*
1409     *--------------------------------------------------------------
1410     *
1411     * Tk_FreeSavedOptions --
1412     *
1413     * Free all of the saved configuration option values from a
1414     * previous call to Tk_SetOptions.
1415     *
1416     * Results:
1417     * None.
1418     *
1419     * Side effects:
1420     * Storage and system resources are freed.
1421     *
1422     *--------------------------------------------------------------
1423     */
1424    
1425     void
1426     Tk_FreeSavedOptions(savePtr)
1427     Tk_SavedOptions *savePtr; /* Contains options saved in a previous
1428     * call to Tk_SetOptions. */
1429     {
1430     int count;
1431     Tk_SavedOption *savedOptionPtr;
1432    
1433     if (savePtr->nextPtr != NULL) {
1434     Tk_FreeSavedOptions(savePtr->nextPtr);
1435     ckfree((char *) savePtr->nextPtr);
1436     }
1437     for (count = savePtr->numItems,
1438     savedOptionPtr = &savePtr->items[savePtr->numItems-1];
1439     count > 0; count--, savedOptionPtr--) {
1440     if (savedOptionPtr->optionPtr->flags & OPTION_NEEDS_FREEING) {
1441     FreeResources(savedOptionPtr->optionPtr, savedOptionPtr->valuePtr,
1442     (char *) &savedOptionPtr->internalForm, savePtr->tkwin);
1443     }
1444     if (savedOptionPtr->valuePtr != NULL) {
1445     Tcl_DecrRefCount(savedOptionPtr->valuePtr);
1446     }
1447     }
1448     }
1449    
1450     /*
1451     *----------------------------------------------------------------------
1452     *
1453     * Tk_FreeConfigOptions --
1454     *
1455     * Free all resources associated with configuration options.
1456     *
1457     * Results:
1458     * None.
1459     *
1460     * Side effects:
1461     * All of the Tcl_Obj's in recordPtr that are controlled by
1462     * configuration options in optionTable are freed.
1463     *
1464     *----------------------------------------------------------------------
1465     */
1466    
1467     /* ARGSUSED */
1468     void
1469     Tk_FreeConfigOptions(recordPtr, optionTable, tkwin)
1470     char *recordPtr; /* Record whose fields contain current
1471     * values for options. */
1472     Tk_OptionTable optionTable; /* Describes legal options. */
1473     Tk_Window tkwin; /* Window associated with recordPtr; needed
1474     * for freeing some options. */
1475     {
1476     OptionTable *tablePtr;
1477     Option *optionPtr;
1478     int count;
1479     Tcl_Obj **oldPtrPtr, *oldPtr;
1480     char *oldInternalPtr;
1481     CONST Tk_OptionSpec *specPtr;
1482    
1483     for (tablePtr = (OptionTable *) optionTable; tablePtr != NULL;
1484     tablePtr = tablePtr->nextPtr) {
1485     for (optionPtr = tablePtr->options, count = tablePtr->numOptions;
1486     count > 0; optionPtr++, count--) {
1487     specPtr = optionPtr->specPtr;
1488     if (specPtr->type == TK_OPTION_SYNONYM) {
1489     continue;
1490     }
1491     if (specPtr->objOffset >= 0) {
1492     oldPtrPtr = (Tcl_Obj **) (recordPtr + specPtr->objOffset);
1493     oldPtr = *oldPtrPtr;
1494     *oldPtrPtr = NULL;
1495     } else {
1496     oldPtr = NULL;
1497     }
1498     if (specPtr->internalOffset >= 0) {
1499     oldInternalPtr = recordPtr + specPtr->internalOffset;
1500     } else {
1501     oldInternalPtr = NULL;
1502     }
1503     if (optionPtr->flags & OPTION_NEEDS_FREEING) {
1504     FreeResources(optionPtr, oldPtr, oldInternalPtr, tkwin);
1505     }
1506     if (oldPtr != NULL) {
1507     Tcl_DecrRefCount(oldPtr);
1508     }
1509     }
1510     }
1511     }
1512    
1513     /*
1514     *----------------------------------------------------------------------
1515     *
1516     * FreeResources --
1517     *
1518     * Free system resources associated with a configuration option,
1519     * such as colors or fonts.
1520     *
1521     * Results:
1522     * None.
1523     *
1524     * Side effects:
1525     * Any system resources associated with objPtr are released. However,
1526     * objPtr itself is not freed.
1527     *
1528     *----------------------------------------------------------------------
1529     */
1530    
1531     static void
1532     FreeResources(optionPtr, objPtr, internalPtr, tkwin)
1533     Option *optionPtr; /* Description of the configuration option. */
1534     Tcl_Obj *objPtr; /* The current value of the option, specified
1535     * as an object. */
1536     char *internalPtr; /* A pointer to an internal representation for
1537     * the option's value, such as an int or
1538     * (XColor *). Only valid if
1539     * optionPtr->specPtr->internalOffset >= 0. */
1540     Tk_Window tkwin; /* The window in which this option is used. */
1541     {
1542     int internalFormExists;
1543    
1544     /*
1545     * If there exists an internal form for the value, use it to free
1546     * resources (also zero out the internal form). If there is no
1547     * internal form, then use the object form.
1548     */
1549    
1550     internalFormExists = optionPtr->specPtr->internalOffset >= 0;
1551     switch (optionPtr->specPtr->type) {
1552     case TK_OPTION_STRING:
1553     if (internalFormExists) {
1554     if (*((char **) internalPtr) != NULL) {
1555     ckfree(*((char **) internalPtr));
1556     *((char **) internalPtr) = NULL;
1557     }
1558     }
1559     break;
1560     case TK_OPTION_COLOR:
1561     if (internalFormExists) {
1562     if (*((XColor **) internalPtr) != NULL) {
1563     Tk_FreeColor(*((XColor **) internalPtr));
1564     *((XColor **) internalPtr) = NULL;
1565     }
1566     } else if (objPtr != NULL) {
1567     Tk_FreeColorFromObj(tkwin, objPtr);
1568     }
1569     break;
1570     case TK_OPTION_FONT:
1571     if (internalFormExists) {
1572     Tk_FreeFont(*((Tk_Font *) internalPtr));
1573     *((Tk_Font *) internalPtr) = NULL;
1574     } else if (objPtr != NULL) {
1575     Tk_FreeFontFromObj(tkwin, objPtr);
1576     }
1577     break;
1578     case TK_OPTION_BITMAP:
1579     if (internalFormExists) {
1580     if (*((Pixmap *) internalPtr) != None) {
1581     Tk_FreeBitmap(Tk_Display(tkwin), *((Pixmap *) internalPtr));
1582     *((Pixmap *) internalPtr) = None;
1583     }
1584     } else if (objPtr != NULL) {
1585     Tk_FreeBitmapFromObj(tkwin, objPtr);
1586     }
1587     break;
1588     case TK_OPTION_BORDER:
1589     if (internalFormExists) {
1590     if (*((Tk_3DBorder *) internalPtr) != NULL) {
1591     Tk_Free3DBorder(*((Tk_3DBorder *) internalPtr));
1592     *((Tk_3DBorder *) internalPtr) = NULL;
1593     }
1594     } else if (objPtr != NULL) {
1595     Tk_Free3DBorderFromObj(tkwin, objPtr);
1596     }
1597     break;
1598     case TK_OPTION_CURSOR:
1599     if (internalFormExists) {
1600     if (*((Tk_Cursor *) internalPtr) != None) {
1601     Tk_FreeCursor(Tk_Display(tkwin),
1602     *((Tk_Cursor *) internalPtr));
1603     *((Tk_Cursor *) internalPtr) = None;
1604     }
1605     } else if (objPtr != NULL) {
1606     Tk_FreeCursorFromObj(tkwin, objPtr);
1607     }
1608     break;
1609     default:
1610     break;
1611     }
1612     }
1613    
1614     /*
1615     *--------------------------------------------------------------
1616     *
1617     * Tk_GetOptionInfo --
1618     *
1619     * Returns a list object containing complete information about
1620     * either a single option or all the configuration options in a
1621     * table.
1622     *
1623     * Results:
1624     * This procedure normally returns a pointer to an object.
1625     * If namePtr isn't NULL, then the result object is a list with
1626     * five elements: the option's name, its database name, database
1627     * class, default value, and current value. If the option is a
1628     * synonym then the list will contain only two values: the option
1629     * name and the name of the option it refers to. If namePtr is
1630     * NULL, then information is returned for every option in the
1631     * option table: the result will have one sub-list (in the form
1632     * described above) for each option in the table. If an error
1633     * occurs (e.g. because namePtr isn't valid) then NULL is returned
1634     * and an error message will be left in interp's result unless
1635     * interp is NULL.
1636     *
1637     * Side effects:
1638     * None.
1639     *
1640     *--------------------------------------------------------------
1641     */
1642    
1643     Tcl_Obj *
1644     Tk_GetOptionInfo(interp, recordPtr, optionTable, namePtr, tkwin)
1645     Tcl_Interp *interp; /* Interpreter for error reporting. If
1646     * NULL, then no error message is created. */
1647     char *recordPtr; /* Record whose fields contain current
1648     * values for options. */
1649     Tk_OptionTable optionTable; /* Describes all the legal options. */
1650     Tcl_Obj *namePtr; /* If non-NULL, the string value selects
1651     * a single option whose info is to be
1652     * returned. Otherwise info is returned for
1653     * all options in optionTable. */
1654     Tk_Window tkwin; /* Window associated with recordPtr; needed
1655     * to compute correct default value for some
1656     * options. */
1657     {
1658     Tcl_Obj *resultPtr;
1659     OptionTable *tablePtr = (OptionTable *) optionTable;
1660     Option *optionPtr;
1661     int count;
1662    
1663     /*
1664     * If information is only wanted for a single configuration
1665     * spec, then handle that one spec specially.
1666     */
1667    
1668     if (namePtr != NULL) {
1669     optionPtr = GetOptionFromObj(interp, namePtr, tablePtr);
1670     if (optionPtr == NULL) {
1671     return (Tcl_Obj *) NULL;
1672     }
1673     if (optionPtr->specPtr->type == TK_OPTION_SYNONYM) {
1674     optionPtr = optionPtr->extra.synonymPtr;
1675     }
1676     return GetConfigList(recordPtr, optionPtr, tkwin);
1677     }
1678    
1679     /*
1680     * Loop through all the specs, creating a big list with all
1681     * their information.
1682     */
1683    
1684     resultPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
1685     for (; tablePtr != NULL; tablePtr = tablePtr->nextPtr) {
1686     for (optionPtr = tablePtr->options, count = tablePtr->numOptions;
1687     count > 0; optionPtr++, count--) {
1688     Tcl_ListObjAppendElement(interp, resultPtr,
1689     GetConfigList(recordPtr, optionPtr, tkwin));
1690     }
1691     }
1692     return resultPtr;
1693     }
1694    
1695     /*
1696     *--------------------------------------------------------------
1697     *
1698     * GetConfigList --
1699     *
1700     * Create a valid Tcl list holding the configuration information
1701     * for a single configuration option.
1702     *
1703     * Results:
1704     * A Tcl list, dynamically allocated. The caller is expected to
1705     * arrange for this list to be freed eventually.
1706     *
1707     * Side effects:
1708     * Memory is allocated.
1709     *
1710     *--------------------------------------------------------------
1711     */
1712    
1713     static Tcl_Obj *
1714     GetConfigList(recordPtr, optionPtr, tkwin)
1715     char *recordPtr; /* Pointer to record holding current
1716     * values of configuration options. */
1717     Option *optionPtr; /* Pointer to information describing a
1718     * particular option. */
1719     Tk_Window tkwin; /* Window corresponding to recordPtr. */
1720     {
1721     Tcl_Obj *listPtr, *elementPtr;
1722    
1723     listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
1724     Tcl_ListObjAppendElement((Tcl_Interp *) NULL, listPtr,
1725     Tcl_NewStringObj(optionPtr->specPtr->optionName, -1));
1726    
1727     if (optionPtr->specPtr->type == TK_OPTION_SYNONYM) {
1728     elementPtr = Tcl_NewStringObj(
1729     optionPtr->extra.synonymPtr->specPtr->optionName, -1);
1730     Tcl_ListObjAppendElement((Tcl_Interp *) NULL, listPtr, elementPtr);
1731     } else {
1732     if (optionPtr->dbNameUID == NULL) {
1733     elementPtr = Tcl_NewObj();
1734     } else {
1735     elementPtr = Tcl_NewStringObj(optionPtr->dbNameUID, -1);
1736     }
1737     Tcl_ListObjAppendElement((Tcl_Interp *) NULL, listPtr, elementPtr);
1738    
1739     if (optionPtr->dbClassUID == NULL) {
1740     elementPtr = Tcl_NewObj();
1741     } else {
1742     elementPtr = Tcl_NewStringObj(optionPtr->dbClassUID, -1);
1743     }
1744     Tcl_ListObjAppendElement((Tcl_Interp *) NULL, listPtr, elementPtr);
1745    
1746     if ((tkwin != NULL) && ((optionPtr->specPtr->type == TK_OPTION_COLOR)
1747     || (optionPtr->specPtr->type == TK_OPTION_BORDER))
1748     && (Tk_Depth(tkwin) <= 1)
1749     && (optionPtr->extra.monoColorPtr != NULL)) {
1750     elementPtr = optionPtr->extra.monoColorPtr;
1751     } else if (optionPtr->defaultPtr != NULL) {
1752     elementPtr = optionPtr->defaultPtr;
1753     } else {
1754     elementPtr = Tcl_NewObj();
1755     }
1756     Tcl_ListObjAppendElement((Tcl_Interp *) NULL, listPtr, elementPtr);
1757    
1758     if (optionPtr->specPtr->objOffset >= 0) {
1759     elementPtr = *((Tcl_Obj **) (recordPtr
1760     + optionPtr->specPtr->objOffset));
1761     if (elementPtr == NULL) {
1762     elementPtr = Tcl_NewObj();
1763     }
1764     } else {
1765     elementPtr = GetObjectForOption(recordPtr, optionPtr, tkwin);
1766     }
1767     Tcl_ListObjAppendElement((Tcl_Interp *) NULL, listPtr, elementPtr);
1768     }
1769     return listPtr;
1770     }
1771    
1772     /*
1773     *----------------------------------------------------------------------
1774     *
1775     * GetObjectForOption --
1776     *
1777     * This procedure is called to create an object that contains the
1778     * value for an option. It is invoked by GetConfigList and
1779     * Tk_GetOptionValue when only the internal form of an option is
1780     * stored in the record.
1781     *
1782     * Results:
1783     * The return value is a pointer to a Tcl object. The caller
1784     * must call Tcl_IncrRefCount on this object to preserve it.
1785     *
1786     * Side effects:
1787     * None.
1788     *
1789     *----------------------------------------------------------------------
1790     */
1791    
1792     static Tcl_Obj *
1793     GetObjectForOption(recordPtr, optionPtr, tkwin)
1794     char *recordPtr; /* Pointer to record holding current
1795     * values of configuration options. */
1796     Option *optionPtr; /* Pointer to information describing an
1797     * option whose internal value is stored
1798     * in *recordPtr. */
1799     Tk_Window tkwin; /* Window corresponding to recordPtr. */
1800     {
1801     Tcl_Obj *objPtr;
1802     char *internalPtr; /* Points to internal value of option in
1803     * record. */
1804    
1805     internalPtr = recordPtr + optionPtr->specPtr->internalOffset;
1806     objPtr = NULL;
1807     switch (optionPtr->specPtr->type) {
1808     case TK_OPTION_BOOLEAN: {
1809     objPtr = Tcl_NewIntObj(*((int *) internalPtr));
1810     break;
1811     }
1812     case TK_OPTION_INT: {
1813     objPtr = Tcl_NewIntObj(*((int *) internalPtr));
1814     break;
1815     }
1816     case TK_OPTION_DOUBLE: {
1817     objPtr = Tcl_NewDoubleObj(*((double *) internalPtr));
1818     break;
1819     }
1820     case TK_OPTION_STRING: {
1821     objPtr = Tcl_NewStringObj(*((char **) internalPtr), -1);
1822     break;
1823     }
1824     case TK_OPTION_STRING_TABLE: {
1825     objPtr = Tcl_NewStringObj(
1826     ((char **) optionPtr->specPtr->clientData)[
1827     *((int *) internalPtr)], -1);
1828     break;
1829     }
1830     case TK_OPTION_COLOR: {
1831     XColor *colorPtr = *((XColor **) internalPtr);
1832     if (colorPtr != NULL) {
1833     objPtr = Tcl_NewStringObj(Tk_NameOfColor(colorPtr), -1);
1834     }
1835     break;
1836     }
1837     case TK_OPTION_FONT: {
1838     Tk_Font tkfont = *((Tk_Font *) internalPtr);
1839     if (tkfont != NULL) {
1840     objPtr = Tcl_NewStringObj(Tk_NameOfFont(tkfont), -1);
1841     }
1842     break;
1843     }
1844     case TK_OPTION_BITMAP: {
1845     Pixmap pixmap = *((Pixmap *) internalPtr);
1846     if (pixmap != None) {
1847     objPtr = Tcl_NewStringObj(Tk_NameOfBitmap(Tk_Display(tkwin),
1848     pixmap), -1);
1849     }
1850     break;
1851     }
1852     case TK_OPTION_BORDER: {
1853     Tk_3DBorder border = *((Tk_3DBorder *) internalPtr);
1854     if (border != NULL) {
1855     objPtr = Tcl_NewStringObj(Tk_NameOf3DBorder(border), -1);
1856     }
1857     break;
1858     }
1859     case TK_OPTION_RELIEF: {
1860     objPtr = Tcl_NewStringObj(Tk_NameOfRelief(
1861     *((int *) internalPtr)), -1);
1862     break;
1863     }
1864     case TK_OPTION_CURSOR: {
1865     Tk_Cursor cursor = *((Tk_Cursor *) internalPtr);
1866     if (cursor != None) {
1867     objPtr = Tcl_NewStringObj(
1868     Tk_NameOfCursor(Tk_Display(tkwin), cursor), -1);
1869     }
1870     break;
1871     }
1872     case TK_OPTION_JUSTIFY: {
1873     objPtr = Tcl_NewStringObj(Tk_NameOfJustify(
1874     *((Tk_Justify *) internalPtr)), -1);
1875     break;
1876     }
1877     case TK_OPTION_ANCHOR: {
1878     objPtr = Tcl_NewStringObj(Tk_NameOfAnchor(
1879     *((Tk_Anchor *) internalPtr)), -1);
1880     break;
1881     }
1882     case TK_OPTION_PIXELS: {
1883     objPtr = Tcl_NewIntObj(*((int *) internalPtr));
1884     break;
1885     }
1886     case TK_OPTION_WINDOW: {
1887     Tk_Window tkwin = *((Tk_Window *) internalPtr);
1888     if (tkwin != NULL) {
1889     objPtr = Tcl_NewStringObj(Tk_PathName(tkwin), -1);
1890     }
1891     break;
1892     }
1893     default: {
1894     panic("bad option type in GetObjectForOption");
1895     }
1896     }
1897     if (objPtr == NULL) {
1898     objPtr = Tcl_NewObj();
1899     }
1900     return objPtr;
1901     }
1902    
1903     /*
1904     *----------------------------------------------------------------------
1905     *
1906     * Tk_GetOptionValue --
1907     *
1908     * This procedure returns the current value of a configuration
1909     * option.
1910     *
1911     * Results:
1912     * The return value is the object holding the current value of
1913     * the option given by namePtr. If no such option exists, then
1914     * the return value is NULL and an error message is left in
1915     * interp's result (if interp isn't NULL).
1916     *
1917     * Side effects:
1918     * None.
1919     *
1920     *----------------------------------------------------------------------
1921     */
1922    
1923     Tcl_Obj *
1924     Tk_GetOptionValue(interp, recordPtr, optionTable, namePtr, tkwin)
1925     Tcl_Interp *interp; /* Interpreter for error reporting. If
1926     * NULL then no messages are provided for
1927     * errors. */
1928     char *recordPtr; /* Record whose fields contain current
1929     * values for options. */
1930     Tk_OptionTable optionTable; /* Describes legal options. */
1931     Tcl_Obj *namePtr; /* Gives the command-line name for the
1932     * option whose value is to be returned. */
1933     Tk_Window tkwin; /* Window corresponding to recordPtr. */
1934     {
1935     OptionTable *tablePtr = (OptionTable *) optionTable;
1936     Option *optionPtr;
1937     Tcl_Obj *resultPtr;
1938    
1939     optionPtr = GetOptionFromObj(interp, namePtr, tablePtr);
1940     if (optionPtr == NULL) {
1941     return NULL;
1942     }
1943     if (optionPtr->specPtr->type == TK_OPTION_SYNONYM) {
1944     optionPtr = optionPtr->extra.synonymPtr;
1945     }
1946     if (optionPtr->specPtr->objOffset >= 0) {
1947     resultPtr = *((Tcl_Obj **) (recordPtr + optionPtr->specPtr->objOffset));
1948     if (resultPtr == NULL) {
1949     /*
1950     * This option has a null value and is represented by a null
1951     * object pointer. We can't return the null pointer, since that
1952     * would indicate an error. Instead, return a new empty object.
1953     */
1954    
1955     resultPtr = Tcl_NewObj();
1956     }
1957     } else {
1958     resultPtr = GetObjectForOption(recordPtr, optionPtr, tkwin);
1959     }
1960     return resultPtr;
1961     }
1962    
1963     /*
1964     *----------------------------------------------------------------------
1965     *
1966     * TkDebugConfig --
1967     *
1968     * This is a debugging procedure that returns information about
1969     * one of the configuration tables that currently exists for an
1970     * interpreter.
1971     *
1972     * Results:
1973     * If the specified table exists in the given interpreter, then a
1974     * list is returned describing the table and any other tables that
1975     * it chains to: for each table there will be three list elements
1976     * giving the reference count for the table, the number of elements
1977     * in the table, and the command-line name for the first option
1978     * in the table. If the table doesn't exist in the interpreter
1979     * then an empty object is returned. The reference count for the
1980     * returned object is 0.
1981     *
1982     * Side effects:
1983     * None.
1984     *
1985     *----------------------------------------------------------------------
1986     */
1987    
1988     Tcl_Obj *
1989     TkDebugConfig(interp, table)
1990     Tcl_Interp *interp; /* Interpreter in which the table is
1991     * defined. */
1992     Tk_OptionTable table; /* Table about which information is to
1993     * be returned. May not necessarily
1994     * exist in the interpreter anymore. */
1995     {
1996     OptionTable *tablePtr = (OptionTable *) table;
1997     Tcl_HashTable *hashTablePtr;
1998     Tcl_HashEntry *hashEntryPtr;
1999     Tcl_HashSearch search;
2000     Tcl_Obj *objPtr;
2001    
2002     objPtr = Tcl_NewObj();
2003     hashTablePtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, OPTION_HASH_KEY,
2004     NULL);
2005     if (hashTablePtr == NULL) {
2006     return objPtr;
2007     }
2008    
2009     /*
2010     * Scan all the tables for this interpreter to make sure that the
2011     * one we want still is valid.
2012     */
2013    
2014     for (hashEntryPtr = Tcl_FirstHashEntry(hashTablePtr, &search);
2015     hashEntryPtr != NULL;
2016     hashEntryPtr = Tcl_NextHashEntry(&search)) {
2017     if (tablePtr == (OptionTable *) Tcl_GetHashValue(hashEntryPtr)) {
2018     for ( ; tablePtr != NULL; tablePtr = tablePtr->nextPtr) {
2019     Tcl_ListObjAppendElement((Tcl_Interp *) NULL, objPtr,
2020     Tcl_NewIntObj(tablePtr->refCount));
2021     Tcl_ListObjAppendElement((Tcl_Interp *) NULL, objPtr,
2022     Tcl_NewIntObj(tablePtr->numOptions));
2023     Tcl_ListObjAppendElement((Tcl_Interp *) NULL, objPtr,
2024     Tcl_NewStringObj(
2025     tablePtr->options[0].specPtr->optionName,
2026     -1));
2027     }
2028     break;
2029     }
2030     }
2031     return objPtr;
2032     }
2033    
2034    
2035     /* $History: tkConfig.c $
2036     *
2037     * ***************** Version 1 *****************
2038     * User: Dtashley Date: 1/02/01 Time: 2:40a
2039     * Created in $/IjuScripter, IjuConsole/Source/Tk Base
2040     * Initial check-in.
2041     */
2042    
2043     /* End of TKCONFIG.C */

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25