![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to tkconfig.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Micropolis - Activity] / micropolis / src / tk|
Return to tkconfig.c CVS log | Up to [Micropolis - Activity] / micropolis / src / tk |
1.1 root 1: /*
2: * tkConfig.c --
3: *
4: * This file contains the Tk_ConfigureWidget procedure.
5: *
6: * Copyright 1990-1992 Regents of the University of California.
7: * Permission to use, copy, modify, and distribute this
8: * software and its documentation for any purpose and without
9: * fee is hereby granted, provided that the above copyright
10: * notice appear in all copies. The University of California
11: * makes no representations about the suitability of this
12: * software for any purpose. It is provided "as is" without
13: * express or implied warranty.
14: */
15:
16: #ifndef lint
17: static char rcsid[] = "$Header: /user6/ouster/wish/RCS/tkConfig.c,v 1.28 92/07/25 15:52:26 ouster Exp $ SPRITE (Berkeley)";
18: #endif
19:
20: #include "tkconfig.h"
21: #include "tk.h"
22:
23: /*
24: * Values for "flags" field of Tk_ConfigSpec structures. Be sure
25: * to coordinate these values with those defined in tk.h
26: * (TK_CONFIG_COLOR_ONLY, etc.). There must not be overlap!
27: *
28: * INIT - Non-zero means (char *) things have been
29: * converted to Tk_Uid's.
30: */
31:
32: #define INIT 0x20
33:
34: /*
35: * Forward declarations for procedures defined later in this file:
36: */
37:
38: static int DoConfig _ANSI_ARGS_((Tcl_Interp *interp,
39: Tk_Window tkwin, Tk_ConfigSpec *specPtr,
40: Tk_Uid value, int valueIsUid, char *widgRec));
41: static Tk_ConfigSpec * FindConfigSpec _ANSI_ARGS_ ((Tcl_Interp *interp,
42: Tk_ConfigSpec *specs, char *argvName,
43: int needFlags, int hateFlags));
44: static char * FormatConfigInfo _ANSI_ARGS_ ((Tk_Window tkwin,
45: Tk_ConfigSpec *specPtr, char *widgRec));
46:
47: /*
48: *--------------------------------------------------------------
49: *
50: * Tk_ConfigureWidget --
51: *
52: * Process command-line options and database options to
53: * fill in fields of a widget record with resources and
54: * other parameters.
55: *
56: * Results:
57: * A standard Tcl return value. In case of an error,
58: * interp->result will hold an error message.
59: *
60: * Side effects:
61: * The fields of widgRec get filled in with information
62: * from argc/argv and the option database. Old information
63: * in widgRec's fields gets recycled.
64: *
65: *--------------------------------------------------------------
66: */
67:
68: int
69: Tk_ConfigureWidget(interp, tkwin, specs, argc, argv, widgRec, flags)
70: Tcl_Interp *interp; /* Interpreter for error reporting. */
71: Tk_Window tkwin; /* Window containing widget (needed to
72: * set up X resources). */
73: Tk_ConfigSpec *specs; /* Describes legal options. */
74: int argc; /* Number of elements in argv. */
75: char **argv; /* Command-line options. */
76: char *widgRec; /* Record whose fields are to be
77: * modified. Values must be properly
78: * initialized. */
79: int flags; /* Used to specify additional flags
80: * that must be present in config specs
81: * for them to be considered. Also,
82: * may have TK_CONFIG_ARGV_ONLY set. */
83: {
84: register Tk_ConfigSpec *specPtr;
85: Tk_Uid value; /* Value of option from database. */
86: int needFlags; /* Specs must contain this set of flags
87: * or else they are not considered. */
88: int hateFlags; /* If a spec contains any bits here, it's
89: * not considered. */
90:
91: needFlags = flags & ~(TK_CONFIG_USER_BIT - 1);
92: if (Tk_DefaultDepth(Tk_Screen(tkwin)) == 1) {
93: hateFlags = TK_CONFIG_COLOR_ONLY;
94: } else {
95: hateFlags = TK_CONFIG_MONO_ONLY;
96: }
97:
98: /*
99: * Pass one: scan through all the option specs, replacing strings
100: * with Tk_Uids (if this hasn't been done already) and clearing
101: * the TK_CONFIG_OPTION_SPECIFIED flags.
102: */
103:
104: for (specPtr = specs; specPtr->type != TK_CONFIG_END; specPtr++) {
105: if (!(specPtr->specFlags & INIT) && (specPtr->argvName != NULL)) {
106: if (specPtr->dbName != NULL) {
107: specPtr->dbName = Tk_GetUid(specPtr->dbName);
108: }
109: if (specPtr->dbClass != NULL) {
110: specPtr->dbClass = Tk_GetUid(specPtr->dbClass);
111: }
112: if (specPtr->defValue != NULL) {
113: specPtr->defValue = Tk_GetUid(specPtr->defValue);
114: }
115: }
116: specPtr->specFlags = (specPtr->specFlags & ~TK_CONFIG_OPTION_SPECIFIED)
117: | INIT;
118: }
119:
120: /*
121: * Pass two: scan through all of the arguments, processing those
122: * that match entries in the specs.
123: */
124:
125: for ( ; argc > 0; argc -= 2, argv += 2) {
126: specPtr = FindConfigSpec(interp, specs, *argv, needFlags, hateFlags);
127: if (specPtr == NULL) {
128: return TCL_ERROR;
129: }
130:
131: /*
132: * Process the entry.
133: */
134:
135: if (argc < 2) {
136: Tcl_AppendResult(interp, "value for \"", *argv,
137: "\" missing", (char *) NULL);
138: return TCL_ERROR;
139: }
140: if (DoConfig(interp, tkwin, specPtr, argv[1], 0, widgRec) != TCL_OK) {
141: char msg[100];
142:
143: sprintf(msg, "\n (processing \"%.40s\" option)",
144: specPtr->argvName);
145: Tcl_AddErrorInfo(interp, msg);
146: return TCL_ERROR;
147: }
148: specPtr->specFlags |= TK_CONFIG_OPTION_SPECIFIED;
149: }
150:
151: /*
152: * Pass three: scan through all of the specs again; if no
153: * command-line argument matched a spec, then check for info
154: * in the option database. If there was nothing in the
155: * database, then use the default.
156: */
157:
158: if (!(flags & TK_CONFIG_ARGV_ONLY)) {
159: for (specPtr = specs; specPtr->type != TK_CONFIG_END; specPtr++) {
160: if ((specPtr->specFlags & TK_CONFIG_OPTION_SPECIFIED)
161: || (specPtr->argvName == NULL)
162: || (specPtr->type == TK_CONFIG_SYNONYM)) {
163: continue;
164: }
165: if (((specPtr->specFlags & needFlags) != needFlags)
166: || (specPtr->specFlags & hateFlags)) {
167: continue;
168: }
169: value = NULL;
170: if (specPtr->dbName != NULL) {
171: value = Tk_GetOption(tkwin, specPtr->dbName, specPtr->dbClass);
172: }
173: if (value != NULL) {
174: if (DoConfig(interp, tkwin, specPtr, value, 1, widgRec) !=
175: TCL_OK) {
176: char msg[200];
177:
178: sprintf(msg, "\n (%s \"%.50s\" in widget \"%.50s\")",
179: "database entry for",
180: specPtr->dbName, Tk_PathName(tkwin));
181: Tcl_AddErrorInfo(interp, msg);
182: return TCL_ERROR;
183: }
184: } else {
185: value = specPtr->defValue;
186: if ((value != NULL) && !(specPtr->specFlags
187: & TK_CONFIG_DONT_SET_DEFAULT)) {
188: if (DoConfig(interp, tkwin, specPtr, value, 1, widgRec) !=
189: TCL_OK) {
190: char msg[200];
191:
192: sprintf(msg,
193: "\n (%s \"%.50s\" in widget \"%.50s\")",
194: "default value for",
195: specPtr->dbName, Tk_PathName(tkwin));
196: Tcl_AddErrorInfo(interp, msg);
197: return TCL_ERROR;
198: }
199: }
200: }
201: }
202: }
203:
204: return TCL_OK;
205: }
206:
207: /*
208: *--------------------------------------------------------------
209: *
210: * FindConfigSpec --
211: *
212: * Search through a table of configuration specs, looking for
213: * one that matches a given argvName.
214: *
215: * Results:
216: * The return value is a pointer to the matching entry, or NULL
217: * if nothing matched. In that case an error message is left
218: * in interp->result.
219: *
220: * Side effects:
221: * None.
222: *
223: *--------------------------------------------------------------
224: */
225:
226: static Tk_ConfigSpec *
227: FindConfigSpec(interp, specs, argvName, needFlags, hateFlags)
228: Tcl_Interp *interp; /* Used for reporting errors. */
229: Tk_ConfigSpec *specs; /* Pointer to table of configuration
230: * specifications for a widget. */
231: char *argvName; /* Name (suitable for use in a "config"
232: * command) identifying particular option. */
233: int needFlags; /* Flags that must be present in matching
234: * entry. */
235: int hateFlags; /* Flags that must NOT be present in
236: * matching entry. */
237: {
238: register Tk_ConfigSpec *specPtr;
239: register char c; /* First character of current argument. */
240: Tk_ConfigSpec *matchPtr; /* Matching spec, or NULL. */
241: int length;
242:
243: c = argvName[1];
244: length = strlen(argvName);
245: matchPtr = NULL;
246: for (specPtr = specs; specPtr->type != TK_CONFIG_END; specPtr++) {
247: if (specPtr->argvName == NULL) {
248: continue;
249: }
250: if ((specPtr->argvName[1] != c)
251: || (strncmp(specPtr->argvName, argvName, length) != 0)) {
252: continue;
253: }
254: if (((specPtr->specFlags & needFlags) != needFlags)
255: || (specPtr->specFlags & hateFlags)) {
256: continue;
257: }
258: if (specPtr->argvName[length] == 0) {
259: matchPtr = specPtr;
260: goto gotMatch;
261: }
262: if (matchPtr != NULL) {
263: Tcl_AppendResult(interp, "ambiguous option \"", argvName,
264: "\"", (char *) NULL);
265: return (Tk_ConfigSpec *) NULL;
266: }
267: matchPtr = specPtr;
268: }
269:
270: if (matchPtr == NULL) {
271: Tcl_AppendResult(interp, "unknown option \"", argvName,
272: "\"", (char *) NULL);
273: return (Tk_ConfigSpec *) NULL;
274: }
275:
276: /*
277: * Found a matching entry. If it's a synonym, then find the
278: * entry that it's a synonym for.
279: */
280:
281: gotMatch:
282: specPtr = matchPtr;
283: if (specPtr->type == TK_CONFIG_SYNONYM) {
284: for (specPtr = specs; ; specPtr++) {
285: if (specPtr->type == TK_CONFIG_END) {
286: Tcl_AppendResult(interp,
287: "couldn't find synonym for option \"",
288: argvName, "\"", (char *) NULL);
289: return (Tk_ConfigSpec *) NULL;
290: }
291: if ((specPtr->dbName == matchPtr->dbName)
292: && (specPtr->type != TK_CONFIG_SYNONYM)
293: && ((specPtr->specFlags & needFlags) == needFlags)
294: && !(specPtr->specFlags & hateFlags)) {
295: break;
296: }
297: }
298: }
299: return specPtr;
300: }
301:
302: /*
303: *--------------------------------------------------------------
304: *
305: * DoConfig --
306: *
307: * This procedure applies a single configuration option
308: * to a widget record.
309: *
310: * Results:
311: * A standard Tcl return value.
312: *
313: * Side effects:
314: * WidgRec is modified as indicated by specPtr and value.
315: * The old value is recycled, if that is appropriate for
316: * the value type.
317: *
318: *--------------------------------------------------------------
319: */
320:
321: static int
322: DoConfig(interp, tkwin, specPtr, value, valueIsUid, widgRec)
323: Tcl_Interp *interp; /* Interpreter for error reporting. */
324: Tk_Window tkwin; /* Window containing widget (needed to
325: * set up X resources). */
326: Tk_ConfigSpec *specPtr; /* Specifier to apply. */
327: char *value; /* Value to use to fill in widgRec. */
328: int valueIsUid; /* Non-zero means value is a Tk_Uid;
329: * zero means it's an ordinary string. */
330: char *widgRec; /* Record whose fields are to be
331: * modified. Values must be properly
332: * initialized. */
333: {
334: char *ptr;
335: Tk_Uid uid;
336: int nullValue;
337:
338: nullValue = 0;
339: if ((*value == 0) && (specPtr->specFlags & TK_CONFIG_NULL_OK)) {
340: nullValue = 1;
341: }
342:
343: do {
344: ptr = widgRec + specPtr->offset;
345: switch (specPtr->type) {
346: case TK_CONFIG_BOOLEAN:
347: if (Tcl_GetBoolean(interp, value, (int *) ptr) != TCL_OK) {
348: return TCL_ERROR;
349: }
350: break;
351: case TK_CONFIG_INT:
352: if (Tcl_GetInt(interp, value, (int *) ptr) != TCL_OK) {
353: return TCL_ERROR;
354: }
355: break;
356: case TK_CONFIG_DOUBLE:
357: if (Tcl_GetDouble(interp, value, (double *) ptr) != TCL_OK) {
358: return TCL_ERROR;
359: }
360: break;
361: case TK_CONFIG_STRING: {
362: char *old, *new;
363:
364: if (nullValue) {
365: new = NULL;
366: } else {
367: new = (char *) ckalloc((unsigned) (strlen(value) + 1));
368: strcpy(new, value);
369: }
370: old = *((char **) ptr);
371: if (old != NULL) {
372: ckfree(old);
373: }
374: *((char **) ptr) = new;
375: break;
376: }
377: case TK_CONFIG_UID:
378: if (nullValue) {
379: *((Tk_Uid *) ptr) = NULL;
380: } else {
381: uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
382: *((Tk_Uid *) ptr) = uid;
383: }
384: break;
385: case TK_CONFIG_COLOR: {
386: XColor *newPtr, *oldPtr;
387:
388: if (nullValue) {
389: newPtr = NULL;
390: } else {
391: uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
392: newPtr = Tk_GetColor(interp, tkwin, (Colormap) None, uid);
393: if (newPtr == NULL) {
394: return TCL_ERROR;
395: }
396: }
397: oldPtr = *((XColor **) ptr);
398: if (oldPtr != NULL) {
399: Tk_FreeColor(oldPtr);
400: }
401: *((XColor **) ptr) = newPtr;
402: break;
403: }
404: case TK_CONFIG_FONT: {
405: XFontStruct *newPtr, *oldPtr;
406:
407: if (nullValue) {
408: newPtr = NULL;
409: } else {
410: uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
411: newPtr = Tk_GetFontStruct(interp, tkwin, uid);
412: if (newPtr == NULL) {
413: return TCL_ERROR;
414: }
415: }
416: oldPtr = *((XFontStruct **) ptr);
417: if (oldPtr != NULL) {
418: Tk_FreeFontStruct(oldPtr);
419: }
420: *((XFontStruct **) ptr) = newPtr;
421: break;
422: }
423: case TK_CONFIG_BITMAP: {
424: Pixmap new, old;
425:
426: if (nullValue) {
427: new = None;
428: } else {
429: uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
430: new = Tk_GetBitmap(interp, tkwin, uid);
431: if (new == None) {
432: return TCL_ERROR;
433: }
434: }
435: old = *((Pixmap *) ptr);
436: if (old != None) {
437: Tk_FreeBitmap(old);
438: }
439: *((Pixmap *) ptr) = new;
440: break;
441: }
442: #if defined(USE_XPM3)
443: case TK_CONFIG_PIXMAP: {
444: Pixmap new, old;
445:
446: if (nullValue) {
447: new = None;
448: } else {
449: uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
450: new = Tk_GetPixmap(interp, tkwin, uid);
451: if (new == None) {
452: return TCL_ERROR;
453: }
454: }
455: old = *((Pixmap *) ptr);
456: if (old != None) {
457: Tk_FreePixmap(old);
458: }
459: *((Pixmap *) ptr) = new;
460: break;
461: }
462: #endif
463: case TK_CONFIG_BORDER: {
464: Tk_3DBorder new, old;
465:
466: if (nullValue) {
467: new = NULL;
468: } else {
469: uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
470: new = Tk_Get3DBorder(interp, tkwin, (Colormap) None, uid);
471: if (new == NULL) {
472: return TCL_ERROR;
473: }
474: }
475: old = *((Tk_3DBorder *) ptr);
476: if (old != NULL) {
477: Tk_Free3DBorder(old);
478: }
479: *((Tk_3DBorder *) ptr) = new;
480: break;
481: }
482: case TK_CONFIG_RELIEF:
483: uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
484: if (Tk_GetRelief(interp, uid, (int *) ptr) != TCL_OK) {
485: return TCL_ERROR;
486: }
487: break;
488: case TK_CONFIG_CURSOR:
489: case TK_CONFIG_ACTIVE_CURSOR: {
490: Cursor new, old;
491:
492: if (nullValue) {
493: new = None;
494: } else {
495: uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
496: new = Tk_GetCursor(interp, tkwin, uid);
497: if (new == None) {
498: return TCL_ERROR;
499: }
500: }
501: old = *((Cursor *) ptr);
502: if (old != None) {
503: Tk_FreeCursor(old);
504: }
505: *((Cursor *) ptr) = new;
506: if (specPtr->type == TK_CONFIG_ACTIVE_CURSOR) {
507: Tk_DefineCursor(tkwin, new);
508: }
509: break;
510: }
511: case TK_CONFIG_JUSTIFY:
512: uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
513: if (Tk_GetJustify(interp, uid, (Tk_Justify *) ptr) != TCL_OK) {
514: return TCL_ERROR;
515: }
516: break;
517: case TK_CONFIG_ANCHOR:
518: uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
519: if (Tk_GetAnchor(interp, uid, (Tk_Anchor *) ptr) != TCL_OK) {
520: return TCL_ERROR;
521: }
522: break;
523: case TK_CONFIG_CAP_STYLE:
524: uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
525: if (Tk_GetCapStyle(interp, uid, (int *) ptr) != TCL_OK) {
526: return TCL_ERROR;
527: }
528: break;
529: case TK_CONFIG_JOIN_STYLE:
530: uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
531: if (Tk_GetJoinStyle(interp, uid, (int *) ptr) != TCL_OK) {
532: return TCL_ERROR;
533: }
534: break;
535: case TK_CONFIG_PIXELS:
536: if (Tk_GetPixels(interp, tkwin, value, (int *) ptr)
537: != TCL_OK) {
538: return TCL_ERROR;
539: }
540: break;
541: case TK_CONFIG_MM:
542: if (Tk_GetScreenMM(interp, tkwin, value, (double *) ptr)
543: != TCL_OK) {
544: return TCL_ERROR;
545: }
546: break;
547: case TK_CONFIG_WINDOW: {
548: Tk_Window tkwin2;
549:
550: if (nullValue) {
551: tkwin2 = NULL;
552: } else {
553: tkwin2 = Tk_NameToWindow(interp, value, tkwin);
554: if (tkwin2 == NULL) {
555: return TCL_ERROR;
556: }
557: }
558: *((Tk_Window *) ptr) = tkwin2;
559: break;
560: }
561: case TK_CONFIG_CUSTOM:
562: if ((*specPtr->customPtr->parseProc)(
563: specPtr->customPtr->clientData, interp, tkwin,
564: value, widgRec, specPtr->offset) != TCL_OK) {
565: return TCL_ERROR;
566: }
567: break;
568: default: {
569: sprintf(interp->result, "bad config table: unknown type %d",
570: specPtr->type);
571: return TCL_ERROR;
572: }
573: }
574: specPtr++;
575: } while ((specPtr->argvName == NULL) && (specPtr->type != TK_CONFIG_END));
576: return TCL_OK;
577: }
578:
579: /*
580: *--------------------------------------------------------------
581: *
582: * Tk_ConfigureInfo --
583: *
584: * Return information about the configuration options
585: * for a window, and their current values.
586: *
587: * Results:
588: * Always returns TCL_OK. Interp->result will be modified
589: * hold a description of either a single configuration option
590: * available for "widgRec" via "specs", or all the configuration
591: * options available. In the "all" case, the result will
592: * available for "widgRec" via "specs". The result will
593: * be a list, each of whose entries describes one option.
594: * Each entry will itself be a list containing the option's
595: * name for use on command lines, database name, database
596: * class, default value, and current value (empty string
597: * if none). For options that are synonyms, the list will
598: * contain only two values: name and synonym name. If the
599: * "name" argument is non-NULL, then the only information
600: * returned is that for the named argument (i.e. the corresponding
601: * entry in the overall list is returned).
602: *
603: * Side effects:
604: * None.
605: *
606: *--------------------------------------------------------------
607: */
608:
609: int
610: Tk_ConfigureInfo(interp, tkwin, specs, widgRec, argvName, flags)
611: Tcl_Interp *interp; /* Interpreter for error reporting. */
612: Tk_Window tkwin; /* Window corresponding to widgRec. */
613: Tk_ConfigSpec *specs; /* Describes legal options. */
614: char *widgRec; /* Record whose fields contain current
615: * values for options. */
616: char *argvName; /* If non-NULL, indicates a single option
617: * whose info is to be returned. Otherwise
618: * info is returned for all options. */
619: int flags; /* Used to specify additional flags
620: * that must be present in config specs
621: * for them to be considered. */
622: {
623: register Tk_ConfigSpec *specPtr;
624: int needFlags, hateFlags;
625: char *list;
626: char *leader = "{";
627:
628: needFlags = flags & ~(TK_CONFIG_USER_BIT - 1);
629: if (Tk_DefaultDepth(Tk_Screen(tkwin)) == 1) {
630: hateFlags = TK_CONFIG_COLOR_ONLY;
631: } else {
632: hateFlags = TK_CONFIG_MONO_ONLY;
633: }
634:
635: /*
636: * If information is only wanted for a single configuration
637: * spec, then handle that one spec specially.
638: */
639:
640: Tcl_SetResult(interp, (char *) NULL, TCL_STATIC);
641: if (argvName != NULL) {
642: specPtr = FindConfigSpec(interp, specs, argvName, needFlags,
643: hateFlags);
644: if (specPtr == NULL) {
645: return TCL_ERROR;
646: }
647: interp->result = FormatConfigInfo(tkwin, specPtr, widgRec);
648: interp->freeProc = TCL_DYNAMIC;
649: return TCL_OK;
650: }
651:
652: /*
653: * Loop through all the specs, creating a big list with all
654: * their information.
655: */
656:
657: for (specPtr = specs; specPtr->type != TK_CONFIG_END; specPtr++) {
658: if ((argvName != NULL) && (specPtr->argvName != argvName)) {
659: continue;
660: }
661: if (((specPtr->specFlags & needFlags) != needFlags)
662: || (specPtr->specFlags & hateFlags)) {
663: continue;
664: }
665: if (specPtr->argvName == NULL) {
666: continue;
667: }
668: list = FormatConfigInfo(tkwin, specPtr, widgRec);
669: Tcl_AppendResult(interp, leader, list, "}", (char *) NULL);
670: ckfree(list);
671: leader = " {";
672: }
673: return TCL_OK;
674: }
675:
676: /*
677: *--------------------------------------------------------------
678: *
679: * FormatConfigInfo --
680: *
681: * Create a valid Tcl list holding the configuration information
682: * for a single configuration option.
683: *
684: * Results:
685: * A Tcl list, dynamically allocated. The caller is expected to
686: * arrange for this list to be freed eventually.
687: *
688: * Side effects:
689: * Memory is allocated.
690: *
691: *--------------------------------------------------------------
692: */
693:
694: static char *
695: FormatConfigInfo(tkwin, specPtr, widgRec)
696: Tk_Window tkwin; /* Window corresponding to widget. */
697: register Tk_ConfigSpec *specPtr; /* Pointer to information describing
698: * option. */
699: char *widgRec; /* Pointer to record holding current
700: * values of info for widget. */
701: {
702: char *argv[6], *ptr, *result;
703: char buffer[200];
704: Tcl_FreeProc *freeProc = (Tcl_FreeProc *) NULL;
705:
706: argv[0] = specPtr->argvName;
707: argv[1] = specPtr->dbName;
708: argv[2] = specPtr->dbClass;
709: argv[3] = specPtr->defValue;
710: if (specPtr->type == TK_CONFIG_SYNONYM) {
711: return Tcl_Merge(2, argv);
712: }
713: ptr = widgRec + specPtr->offset;
714: argv[4] = "";
715: switch (specPtr->type) {
716: case TK_CONFIG_BOOLEAN:
717: if (*((int *) ptr) == 0) {
718: argv[4] = "false";
719: } else {
720: argv[4] = "true";
721: }
722: break;
723: case TK_CONFIG_INT:
724: sprintf(buffer, "%d", *((int *) ptr));
725: argv[4] = buffer;
726: break;
727: case TK_CONFIG_DOUBLE:
728: sprintf(buffer, "%g", *((double *) ptr));
729: argv[4] = buffer;
730: break;
731: case TK_CONFIG_STRING:
732: argv[4] = (*(char **) ptr);
733: break;
734: case TK_CONFIG_UID: {
735: Tk_Uid uid = *((Tk_Uid *) ptr);
736: if (uid != NULL) {
737: argv[4] = uid;
738: }
739: break;
740: }
741: case TK_CONFIG_COLOR: {
742: XColor *colorPtr = *((XColor **) ptr);
743: if (colorPtr != NULL) {
744: argv[4] = Tk_NameOfColor(colorPtr);
745: }
746: break;
747: }
748: case TK_CONFIG_FONT: {
749: XFontStruct *fontStructPtr = *((XFontStruct **) ptr);
750: if (fontStructPtr != NULL) {
751: argv[4] = Tk_NameOfFontStruct(fontStructPtr);
752: }
753: break;
754: }
755: case TK_CONFIG_BITMAP: {
756: Pixmap pixmap = *((Pixmap *) ptr);
757: if (pixmap != None) {
758: argv[4] = Tk_NameOfBitmap(pixmap);
759: }
760: break;
761: }
762: #if defined(USE_XPM3)
763: case TK_CONFIG_PIXMAP: {
764: Pixmap pixmap = *((Pixmap *) ptr);
765: if (pixmap != None) {
766: argv[4] = Tk_NameOfPixmap(pixmap);
767: }
768: break;
769: }
770: #endif
771: case TK_CONFIG_BORDER: {
772: Tk_3DBorder border = *((Tk_3DBorder *) ptr);
773: if (border != NULL) {
774: argv[4] = Tk_NameOf3DBorder(border);
775: }
776: break;
777: }
778: case TK_CONFIG_RELIEF:
779: argv[4] = Tk_NameOfRelief(*((int *) ptr));
780: break;
781: case TK_CONFIG_CURSOR:
782: case TK_CONFIG_ACTIVE_CURSOR: {
783: Cursor cursor = *((Cursor *) ptr);
784: if (cursor != None) {
785: argv[4] = Tk_NameOfCursor(cursor);
786: }
787: break;
788: }
789: case TK_CONFIG_JUSTIFY:
790: argv[4] = Tk_NameOfJustify(*((Tk_Justify *) ptr));
791: break;
792: case TK_CONFIG_ANCHOR:
793: argv[4] = Tk_NameOfAnchor(*((Tk_Anchor *) ptr));
794: break;
795: case TK_CONFIG_CAP_STYLE:
796: argv[4] = Tk_NameOfCapStyle(*((int *) ptr));
797: break;
798: case TK_CONFIG_JOIN_STYLE:
799: argv[4] = Tk_NameOfJoinStyle(*((int *) ptr));
800: break;
801: case TK_CONFIG_PIXELS:
802: sprintf(buffer, "%d", *((int *) ptr));
803: argv[4] = buffer;
804: break;
805: case TK_CONFIG_MM:
806: sprintf(buffer, "%gm", *((int *) ptr));
807: argv[4] = buffer;
808: break;
809: case TK_CONFIG_WINDOW: {
810: Tk_Window tkwin;
811:
812: tkwin = *((Tk_Window *) ptr);
813: if (tkwin != NULL) {
814: argv[4] = Tk_PathName(tkwin);
815: }
816: break;
817: }
818: case TK_CONFIG_CUSTOM:
819: argv[4] = (*specPtr->customPtr->printProc)(
820: specPtr->customPtr->clientData, tkwin, widgRec,
821: specPtr->offset, &freeProc);
822: break;
823: default:
824: argv[4] = "?? unknown type ??";
825: }
826: if (argv[1] == NULL) {
827: argv[1] = "";
828: }
829: if (argv[2] == NULL) {
830: argv[2] = "";
831: }
832: if (argv[3] == NULL) {
833: argv[3] = "";
834: }
835: if (argv[4] == NULL) {
836: argv[4] = "";
837: }
838: result = Tcl_Merge(5, argv);
839: if (freeProc != NULL) {
840: if (freeProc == (Tcl_FreeProc *) free) {
841: ckfree(argv[4]);
842: } else {
843: (*freeProc)(argv[4]);
844: }
845: }
846: return result;
847: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.