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

Contents of /projs/trunk/shared_source/tk_base/tkconfig.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 42 - (show annotations) (download)
Fri Oct 14 01:50:00 2016 UTC (8 years, 1 month ago) by dashley
File MIME type: text/plain
File size: 61734 byte(s)
Move shared source code to commonize.
1 /* $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