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