]> git.zerfleddert.de Git - micropolis/blob - src/tk/tkconfig.c
projects / micropolis / blob
? search:
summary | shortlog | log | commit | commitdiff | tree
blame | history | raw | HEAD
src/sim/makefile: Micropolis build fixes for recent macOS
[micropolis] / src / tk / tkconfig.c
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 \f
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 \f
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 \f
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 \f
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 \f
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 }
Micropolis
Impressum, Datenschutz