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