/[dtapublic]/projs/trunk/shared_source/c_tk_base_7_5_w_mods/tkoldconfig.c
ViewVC logotype

Annotation of /projs/trunk/shared_source/c_tk_base_7_5_w_mods/tkoldconfig.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 69 - (hide annotations) (download)
Sat Nov 5 10:54:17 2016 UTC (7 years, 4 months ago) by dashley
File MIME type: text/plain
File size: 29238 byte(s)
License and property (keyword) changes.
1 dashley 69 /* $Header$ */
2 dashley 25
3     /*
4     * tkOldConfig.c --
5     *
6     * This file contains the Tk_ConfigureWidget procedure. THIS FILE
7     * IS HERE FOR BACKWARD COMPATIBILITY; THE NEW CONFIGURATION
8     * PACKAGE SHOULD BE USED FOR NEW PROJECTS.
9     *
10     * Copyright (c) 1990-1994 The Regents of the University of California.
11     * Copyright (c) 1994-1997 Sun Microsystems, Inc.
12     *
13     * See the file "license.terms" for information on usage and redistribution
14     * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
15     *
16     * RCS: @(#) $Id: tkoldconfig.c,v 1.1.1.1 2001/06/13 05:06:29 dtashley Exp $
17     */
18    
19     #include "tkPort.h"
20     #include "tk.h"
21    
22     /*
23     * Values for "flags" field of Tk_ConfigSpec structures. Be sure
24     * to coordinate these values with those defined in tk.h
25     * (TK_CONFIG_COLOR_ONLY, etc.). There must not be overlap!
26     *
27     * INIT - Non-zero means (char *) things have been
28     * converted to Tk_Uid's.
29     */
30    
31     #define INIT 0x20
32    
33     /*
34     * Forward declarations for procedures defined later in this file:
35     */
36    
37     static int DoConfig _ANSI_ARGS_((Tcl_Interp *interp,
38     Tk_Window tkwin, Tk_ConfigSpec *specPtr,
39     Tk_Uid value, int valueIsUid, char *widgRec));
40     static Tk_ConfigSpec * FindConfigSpec _ANSI_ARGS_((Tcl_Interp *interp,
41     Tk_ConfigSpec *specs, char *argvName,
42     int needFlags, int hateFlags));
43     static char * FormatConfigInfo _ANSI_ARGS_((Tcl_Interp *interp,
44     Tk_Window tkwin, Tk_ConfigSpec *specPtr,
45     char *widgRec));
46     static char * FormatConfigValue _ANSI_ARGS_((Tcl_Interp *interp,
47     Tk_Window tkwin, Tk_ConfigSpec *specPtr,
48     char *widgRec, char *buffer,
49     Tcl_FreeProc **freeProcPtr));
50    
51     /*
52     *--------------------------------------------------------------
53     *
54     * Tk_ConfigureWidget --
55     *
56     * Process command-line options and database options to
57     * fill in fields of a widget record with resources and
58     * other parameters.
59     *
60     * Results:
61     * A standard Tcl return value. In case of an error,
62     * the interp's result will hold an error message.
63     *
64     * Side effects:
65     * The fields of widgRec get filled in with information
66     * from argc/argv and the option database. Old information
67     * in widgRec's fields gets recycled.
68     *
69     *--------------------------------------------------------------
70     */
71    
72     int
73     Tk_ConfigureWidget(interp, tkwin, specs, argc, argv, widgRec, flags)
74     Tcl_Interp *interp; /* Interpreter for error reporting. */
75     Tk_Window tkwin; /* Window containing widget (needed to
76     * set up X resources). */
77     Tk_ConfigSpec *specs; /* Describes legal options. */
78     int argc; /* Number of elements in argv. */
79     char **argv; /* Command-line options. */
80     char *widgRec; /* Record whose fields are to be
81     * modified. Values must be properly
82     * initialized. */
83     int flags; /* Used to specify additional flags
84     * that must be present in config specs
85     * for them to be considered. Also,
86     * may have TK_CONFIG_ARGV_ONLY set. */
87     {
88     register Tk_ConfigSpec *specPtr;
89     Tk_Uid value; /* Value of option from database. */
90     int needFlags; /* Specs must contain this set of flags
91     * or else they are not considered. */
92     int hateFlags; /* If a spec contains any bits here, it's
93     * not considered. */
94    
95     if (tkwin == NULL) {
96     /*
97     * Either we're not really in Tk, or the main window was destroyed and
98     * we're on our way out of the application
99     */
100     Tcl_AppendResult(interp, "NULL main window", (char *)NULL);
101     return TCL_ERROR;
102     }
103    
104     needFlags = flags & ~(TK_CONFIG_USER_BIT - 1);
105     if (Tk_Depth(tkwin) <= 1) {
106     hateFlags = TK_CONFIG_COLOR_ONLY;
107     } else {
108     hateFlags = TK_CONFIG_MONO_ONLY;
109     }
110    
111     /*
112     * Pass one: scan through all the option specs, replacing strings
113     * with Tk_Uid structs (if this hasn't been done already) and
114     * clearing the TK_CONFIG_OPTION_SPECIFIED flags.
115     */
116    
117     for (specPtr = specs; specPtr->type != TK_CONFIG_END; specPtr++) {
118     if (!(specPtr->specFlags & INIT) && (specPtr->argvName != NULL)) {
119     if (specPtr->dbName != NULL) {
120     specPtr->dbName = Tk_GetUid(specPtr->dbName);
121     }
122     if (specPtr->dbClass != NULL) {
123     specPtr->dbClass = Tk_GetUid(specPtr->dbClass);
124     }
125     if (specPtr->defValue != NULL) {
126     specPtr->defValue = Tk_GetUid(specPtr->defValue);
127     }
128     }
129     specPtr->specFlags = (specPtr->specFlags & ~TK_CONFIG_OPTION_SPECIFIED)
130     | INIT;
131     }
132    
133     /*
134     * Pass two: scan through all of the arguments, processing those
135     * that match entries in the specs.
136     */
137    
138     for ( ; argc > 0; argc -= 2, argv += 2) {
139     char *arg;
140    
141     if (flags & TK_CONFIG_OBJS) {
142     arg = Tcl_GetStringFromObj((Tcl_Obj *) *argv, NULL);
143     } else {
144     arg = *argv;
145     }
146     specPtr = FindConfigSpec(interp, specs, arg, needFlags, hateFlags);
147     if (specPtr == NULL) {
148     return TCL_ERROR;
149     }
150    
151     /*
152     * Process the entry.
153     */
154    
155     if (argc < 2) {
156     Tcl_AppendResult(interp, "value for \"", arg,
157     "\" missing", (char *) NULL);
158     return TCL_ERROR;
159     }
160     if (flags & TK_CONFIG_OBJS) {
161     arg = Tcl_GetString((Tcl_Obj *) argv[1]);
162     } else {
163     arg = argv[1];
164     }
165     if (DoConfig(interp, tkwin, specPtr, arg, 0, widgRec) != TCL_OK) {
166     char msg[100];
167    
168     sprintf(msg, "\n (processing \"%.40s\" option)",
169     specPtr->argvName);
170     Tcl_AddErrorInfo(interp, msg);
171     return TCL_ERROR;
172     }
173     specPtr->specFlags |= TK_CONFIG_OPTION_SPECIFIED;
174     }
175    
176     /*
177     * Pass three: scan through all of the specs again; if no
178     * command-line argument matched a spec, then check for info
179     * in the option database. If there was nothing in the
180     * database, then use the default.
181     */
182    
183     if (!(flags & TK_CONFIG_ARGV_ONLY)) {
184     for (specPtr = specs; specPtr->type != TK_CONFIG_END; specPtr++) {
185     if ((specPtr->specFlags & TK_CONFIG_OPTION_SPECIFIED)
186     || (specPtr->argvName == NULL)
187     || (specPtr->type == TK_CONFIG_SYNONYM)) {
188     continue;
189     }
190     if (((specPtr->specFlags & needFlags) != needFlags)
191     || (specPtr->specFlags & hateFlags)) {
192     continue;
193     }
194     value = NULL;
195     if (specPtr->dbName != NULL) {
196     value = Tk_GetOption(tkwin, specPtr->dbName, specPtr->dbClass);
197     }
198     if (value != NULL) {
199     if (DoConfig(interp, tkwin, specPtr, value, 1, widgRec) !=
200     TCL_OK) {
201     char msg[200];
202    
203     sprintf(msg, "\n (%s \"%.50s\" in widget \"%.50s\")",
204     "database entry for",
205     specPtr->dbName, Tk_PathName(tkwin));
206     Tcl_AddErrorInfo(interp, msg);
207     return TCL_ERROR;
208     }
209     } else {
210     if (specPtr->defValue != NULL) {
211     value = Tk_GetUid(specPtr->defValue);
212     } else {
213     value = NULL;
214     }
215     if ((value != NULL) && !(specPtr->specFlags
216     & TK_CONFIG_DONT_SET_DEFAULT)) {
217     if (DoConfig(interp, tkwin, specPtr, value, 1, widgRec) !=
218     TCL_OK) {
219     char msg[200];
220    
221     sprintf(msg,
222     "\n (%s \"%.50s\" in widget \"%.50s\")",
223     "default value for",
224     specPtr->dbName, Tk_PathName(tkwin));
225     Tcl_AddErrorInfo(interp, msg);
226     return TCL_ERROR;
227     }
228     }
229     }
230     }
231     }
232    
233     return TCL_OK;
234     }
235    
236     /*
237     *--------------------------------------------------------------
238     *
239     * FindConfigSpec --
240     *
241     * Search through a table of configuration specs, looking for
242     * one that matches a given argvName.
243     *
244     * Results:
245     * The return value is a pointer to the matching entry, or NULL
246     * if nothing matched. In that case an error message is left
247     * in the interp's result.
248     *
249     * Side effects:
250     * None.
251     *
252     *--------------------------------------------------------------
253     */
254    
255     static Tk_ConfigSpec *
256     FindConfigSpec(interp, specs, argvName, needFlags, hateFlags)
257     Tcl_Interp *interp; /* Used for reporting errors. */
258     Tk_ConfigSpec *specs; /* Pointer to table of configuration
259     * specifications for a widget. */
260     char *argvName; /* Name (suitable for use in a "config"
261     * command) identifying particular option. */
262     int needFlags; /* Flags that must be present in matching
263     * entry. */
264     int hateFlags; /* Flags that must NOT be present in
265     * matching entry. */
266     {
267     register Tk_ConfigSpec *specPtr;
268     register char c; /* First character of current argument. */
269     Tk_ConfigSpec *matchPtr; /* Matching spec, or NULL. */
270     size_t length;
271    
272     c = argvName[1];
273     length = strlen(argvName);
274     matchPtr = NULL;
275     for (specPtr = specs; specPtr->type != TK_CONFIG_END; specPtr++) {
276     if (specPtr->argvName == NULL) {
277     continue;
278     }
279     if ((specPtr->argvName[1] != c)
280     || (strncmp(specPtr->argvName, argvName, length) != 0)) {
281     continue;
282     }
283     if (((specPtr->specFlags & needFlags) != needFlags)
284     || (specPtr->specFlags & hateFlags)) {
285     continue;
286     }
287     if (specPtr->argvName[length] == 0) {
288     matchPtr = specPtr;
289     goto gotMatch;
290     }
291     if (matchPtr != NULL) {
292     Tcl_AppendResult(interp, "ambiguous option \"", argvName,
293     "\"", (char *) NULL);
294     return (Tk_ConfigSpec *) NULL;
295     }
296     matchPtr = specPtr;
297     }
298    
299     if (matchPtr == NULL) {
300     Tcl_AppendResult(interp, "unknown option \"", argvName,
301     "\"", (char *) NULL);
302     return (Tk_ConfigSpec *) NULL;
303     }
304    
305     /*
306     * Found a matching entry. If it's a synonym, then find the
307     * entry that it's a synonym for.
308     */
309    
310     gotMatch:
311     specPtr = matchPtr;
312     if (specPtr->type == TK_CONFIG_SYNONYM) {
313     for (specPtr = specs; ; specPtr++) {
314     if (specPtr->type == TK_CONFIG_END) {
315     Tcl_AppendResult(interp,
316     "couldn't find synonym for option \"",
317     argvName, "\"", (char *) NULL);
318     return (Tk_ConfigSpec *) NULL;
319     }
320     if ((specPtr->dbName == matchPtr->dbName)
321     && (specPtr->type != TK_CONFIG_SYNONYM)
322     && ((specPtr->specFlags & needFlags) == needFlags)
323     && !(specPtr->specFlags & hateFlags)) {
324     break;
325     }
326     }
327     }
328     return specPtr;
329     }
330    
331     /*
332     *--------------------------------------------------------------
333     *
334     * DoConfig --
335     *
336     * This procedure applies a single configuration option
337     * to a widget record.
338     *
339     * Results:
340     * A standard Tcl return value.
341     *
342     * Side effects:
343     * WidgRec is modified as indicated by specPtr and value.
344     * The old value is recycled, if that is appropriate for
345     * the value type.
346     *
347     *--------------------------------------------------------------
348     */
349    
350     static int
351     DoConfig(interp, tkwin, specPtr, value, valueIsUid, widgRec)
352     Tcl_Interp *interp; /* Interpreter for error reporting. */
353     Tk_Window tkwin; /* Window containing widget (needed to
354     * set up X resources). */
355     Tk_ConfigSpec *specPtr; /* Specifier to apply. */
356     char *value; /* Value to use to fill in widgRec. */
357     int valueIsUid; /* Non-zero means value is a Tk_Uid;
358     * zero means it's an ordinary string. */
359     char *widgRec; /* Record whose fields are to be
360     * modified. Values must be properly
361     * initialized. */
362     {
363     char *ptr;
364     Tk_Uid uid;
365     int nullValue;
366    
367     nullValue = 0;
368     if ((*value == 0) && (specPtr->specFlags & TK_CONFIG_NULL_OK)) {
369     nullValue = 1;
370     }
371    
372     do {
373     ptr = widgRec + specPtr->offset;
374     switch (specPtr->type) {
375     case TK_CONFIG_BOOLEAN:
376     if (Tcl_GetBoolean(interp, value, (int *) ptr) != TCL_OK) {
377     return TCL_ERROR;
378     }
379     break;
380     case TK_CONFIG_INT:
381     if (Tcl_GetInt(interp, value, (int *) ptr) != TCL_OK) {
382     return TCL_ERROR;
383     }
384     break;
385     case TK_CONFIG_DOUBLE:
386     if (Tcl_GetDouble(interp, value, (double *) ptr) != TCL_OK) {
387     return TCL_ERROR;
388     }
389     break;
390     case TK_CONFIG_STRING: {
391     char *old, *new;
392    
393     if (nullValue) {
394     new = NULL;
395     } else {
396     new = (char *) ckalloc((unsigned) (strlen(value) + 1));
397     strcpy(new, value);
398     }
399     old = *((char **) ptr);
400     if (old != NULL) {
401     ckfree(old);
402     }
403     *((char **) ptr) = new;
404     break;
405     }
406     case TK_CONFIG_UID:
407     if (nullValue) {
408     *((Tk_Uid *) ptr) = NULL;
409     } else {
410     uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
411     *((Tk_Uid *) ptr) = uid;
412     }
413     break;
414     case TK_CONFIG_COLOR: {
415     XColor *newPtr, *oldPtr;
416    
417     if (nullValue) {
418     newPtr = NULL;
419     } else {
420     uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
421     newPtr = Tk_GetColor(interp, tkwin, uid);
422     if (newPtr == NULL) {
423     return TCL_ERROR;
424     }
425     }
426     oldPtr = *((XColor **) ptr);
427     if (oldPtr != NULL) {
428     Tk_FreeColor(oldPtr);
429     }
430     *((XColor **) ptr) = newPtr;
431     break;
432     }
433     case TK_CONFIG_FONT: {
434     Tk_Font new;
435    
436     if (nullValue) {
437     new = NULL;
438     } else {
439     new = Tk_GetFont(interp, tkwin, value);
440     if (new == NULL) {
441     return TCL_ERROR;
442     }
443     }
444     Tk_FreeFont(*((Tk_Font *) ptr));
445     *((Tk_Font *) ptr) = new;
446     break;
447     }
448     case TK_CONFIG_BITMAP: {
449     Pixmap new, old;
450    
451     if (nullValue) {
452     new = None;
453     } else {
454     uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
455     new = Tk_GetBitmap(interp, tkwin, uid);
456     if (new == None) {
457     return TCL_ERROR;
458     }
459     }
460     old = *((Pixmap *) ptr);
461     if (old != None) {
462     Tk_FreeBitmap(Tk_Display(tkwin), old);
463     }
464     *((Pixmap *) ptr) = new;
465     break;
466     }
467     case TK_CONFIG_BORDER: {
468     Tk_3DBorder new, old;
469    
470     if (nullValue) {
471     new = NULL;
472     } else {
473     uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
474     new = Tk_Get3DBorder(interp, tkwin, uid);
475     if (new == NULL) {
476     return TCL_ERROR;
477     }
478     }
479     old = *((Tk_3DBorder *) ptr);
480     if (old != NULL) {
481     Tk_Free3DBorder(old);
482     }
483     *((Tk_3DBorder *) ptr) = new;
484     break;
485     }
486     case TK_CONFIG_RELIEF:
487     uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
488     if (Tk_GetRelief(interp, uid, (int *) ptr) != TCL_OK) {
489     return TCL_ERROR;
490     }
491     break;
492     case TK_CONFIG_CURSOR:
493     case TK_CONFIG_ACTIVE_CURSOR: {
494     Tk_Cursor new, old;
495    
496     if (nullValue) {
497     new = None;
498     } else {
499     uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
500     new = Tk_GetCursor(interp, tkwin, uid);
501     if (new == None) {
502     return TCL_ERROR;
503     }
504     }
505     old = *((Tk_Cursor *) ptr);
506     if (old != None) {
507     Tk_FreeCursor(Tk_Display(tkwin), old);
508     }
509     *((Tk_Cursor *) ptr) = new;
510     if (specPtr->type == TK_CONFIG_ACTIVE_CURSOR) {
511     Tk_DefineCursor(tkwin, new);
512     }
513     break;
514     }
515     case TK_CONFIG_JUSTIFY:
516     uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
517     if (Tk_GetJustify(interp, uid, (Tk_Justify *) ptr) != TCL_OK) {
518     return TCL_ERROR;
519     }
520     break;
521     case TK_CONFIG_ANCHOR:
522     uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
523     if (Tk_GetAnchor(interp, uid, (Tk_Anchor *) ptr) != TCL_OK) {
524     return TCL_ERROR;
525     }
526     break;
527     case TK_CONFIG_CAP_STYLE:
528     uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
529     if (Tk_GetCapStyle(interp, uid, (int *) ptr) != TCL_OK) {
530     return TCL_ERROR;
531     }
532     break;
533     case TK_CONFIG_JOIN_STYLE:
534     uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
535     if (Tk_GetJoinStyle(interp, uid, (int *) ptr) != TCL_OK) {
536     return TCL_ERROR;
537     }
538     break;
539     case TK_CONFIG_PIXELS:
540     if (Tk_GetPixels(interp, tkwin, value, (int *) ptr)
541     != TCL_OK) {
542     return TCL_ERROR;
543     }
544     break;
545     case TK_CONFIG_MM:
546     if (Tk_GetScreenMM(interp, tkwin, value, (double *) ptr)
547     != TCL_OK) {
548     return TCL_ERROR;
549     }
550     break;
551     case TK_CONFIG_WINDOW: {
552     Tk_Window tkwin2;
553    
554     if (nullValue) {
555     tkwin2 = NULL;
556     } else {
557     tkwin2 = Tk_NameToWindow(interp, value, tkwin);
558     if (tkwin2 == NULL) {
559     return TCL_ERROR;
560     }
561     }
562     *((Tk_Window *) ptr) = tkwin2;
563     break;
564     }
565     case TK_CONFIG_CUSTOM:
566     if ((*specPtr->customPtr->parseProc)(
567     specPtr->customPtr->clientData, interp, tkwin,
568     value, widgRec, specPtr->offset) != TCL_OK) {
569     return TCL_ERROR;
570     }
571     break;
572     default: {
573     char buf[64 + TCL_INTEGER_SPACE];
574    
575     sprintf(buf, "bad config table: unknown type %d",
576     specPtr->type);
577     Tcl_SetResult(interp, buf, TCL_VOLATILE);
578     return TCL_ERROR;
579     }
580     }
581     specPtr++;
582     } while ((specPtr->argvName == NULL) && (specPtr->type != TK_CONFIG_END));
583     return TCL_OK;
584     }
585    
586     /*
587     *--------------------------------------------------------------
588     *
589     * Tk_ConfigureInfo --
590     *
591     * Return information about the configuration options
592     * for a window, and their current values.
593     *
594     * Results:
595     * Always returns TCL_OK. The interp's result will be modified
596     * hold a description of either a single configuration option
597     * available for "widgRec" via "specs", or all the configuration
598     * options available. In the "all" case, the result will
599     * available for "widgRec" via "specs". The result will
600     * be a list, each of whose entries describes one option.
601     * Each entry will itself be a list containing the option's
602     * name for use on command lines, database name, database
603     * class, default value, and current value (empty string
604     * if none). For options that are synonyms, the list will
605     * contain only two values: name and synonym name. If the
606     * "name" argument is non-NULL, then the only information
607     * returned is that for the named argument (i.e. the corresponding
608     * entry in the overall list is returned).
609     *
610     * Side effects:
611     * None.
612     *
613     *--------------------------------------------------------------
614     */
615    
616     int
617     Tk_ConfigureInfo(interp, tkwin, specs, widgRec, argvName, flags)
618     Tcl_Interp *interp; /* Interpreter for error reporting. */
619     Tk_Window tkwin; /* Window corresponding to widgRec. */
620     Tk_ConfigSpec *specs; /* Describes legal options. */
621     char *widgRec; /* Record whose fields contain current
622     * values for options. */
623     char *argvName; /* If non-NULL, indicates a single option
624     * whose info is to be returned. Otherwise
625     * info is returned for all options. */
626     int flags; /* Used to specify additional flags
627     * that must be present in config specs
628     * for them to be considered. */
629     {
630     register Tk_ConfigSpec *specPtr;
631     int needFlags, hateFlags;
632     char *list;
633     char *leader = "{";
634    
635     needFlags = flags & ~(TK_CONFIG_USER_BIT - 1);
636     if (Tk_Depth(tkwin) <= 1) {
637     hateFlags = TK_CONFIG_COLOR_ONLY;
638     } else {
639     hateFlags = TK_CONFIG_MONO_ONLY;
640     }
641    
642     /*
643     * If information is only wanted for a single configuration
644     * spec, then handle that one spec specially.
645     */
646    
647     Tcl_SetResult(interp, (char *) NULL, TCL_STATIC);
648     if (argvName != NULL) {
649     specPtr = FindConfigSpec(interp, specs, argvName, needFlags,
650     hateFlags);
651     if (specPtr == NULL) {
652     return TCL_ERROR;
653     }
654     Tcl_SetResult(interp,
655     FormatConfigInfo(interp, tkwin, specPtr, widgRec),
656     TCL_DYNAMIC);
657     return TCL_OK;
658     }
659    
660     /*
661     * Loop through all the specs, creating a big list with all
662     * their information.
663     */
664    
665     for (specPtr = specs; specPtr->type != TK_CONFIG_END; specPtr++) {
666     if ((argvName != NULL) && (specPtr->argvName != argvName)) {
667     continue;
668     }
669     if (((specPtr->specFlags & needFlags) != needFlags)
670     || (specPtr->specFlags & hateFlags)) {
671     continue;
672     }
673     if (specPtr->argvName == NULL) {
674     continue;
675     }
676     list = FormatConfigInfo(interp, tkwin, specPtr, widgRec);
677     Tcl_AppendResult(interp, leader, list, "}", (char *) NULL);
678     ckfree(list);
679     leader = " {";
680     }
681     return TCL_OK;
682     }
683    
684     /*
685     *--------------------------------------------------------------
686     *
687     * FormatConfigInfo --
688     *
689     * Create a valid Tcl list holding the configuration information
690     * for a single configuration option.
691     *
692     * Results:
693     * A Tcl list, dynamically allocated. The caller is expected to
694     * arrange for this list to be freed eventually.
695     *
696     * Side effects:
697     * Memory is allocated.
698     *
699     *--------------------------------------------------------------
700     */
701    
702     static char *
703     FormatConfigInfo(interp, tkwin, specPtr, widgRec)
704     Tcl_Interp *interp; /* Interpreter to use for things
705     * like floating-point precision. */
706     Tk_Window tkwin; /* Window corresponding to widget. */
707     register Tk_ConfigSpec *specPtr; /* Pointer to information describing
708     * option. */
709     char *widgRec; /* Pointer to record holding current
710     * values of info for widget. */
711     {
712     char *argv[6], *result;
713     char buffer[200];
714     Tcl_FreeProc *freeProc = (Tcl_FreeProc *) NULL;
715    
716     argv[0] = specPtr->argvName;
717     argv[1] = specPtr->dbName;
718     argv[2] = specPtr->dbClass;
719     argv[3] = specPtr->defValue;
720     if (specPtr->type == TK_CONFIG_SYNONYM) {
721     return Tcl_Merge(2, argv);
722     }
723     argv[4] = FormatConfigValue(interp, tkwin, specPtr, widgRec, buffer,
724     &freeProc);
725     if (argv[1] == NULL) {
726     argv[1] = "";
727     }
728     if (argv[2] == NULL) {
729     argv[2] = "";
730     }
731     if (argv[3] == NULL) {
732     argv[3] = "";
733     }
734     if (argv[4] == NULL) {
735     argv[4] = "";
736     }
737     result = Tcl_Merge(5, argv);
738     if (freeProc != NULL) {
739     if ((freeProc == TCL_DYNAMIC) || (freeProc == (Tcl_FreeProc *) free)) {
740     ckfree(argv[4]);
741     } else {
742     (*freeProc)(argv[4]);
743     }
744     }
745     return result;
746     }
747    
748     /*
749     *----------------------------------------------------------------------
750     *
751     * FormatConfigValue --
752     *
753     * This procedure formats the current value of a configuration
754     * option.
755     *
756     * Results:
757     * The return value is the formatted value of the option given
758     * by specPtr and widgRec. If the value is static, so that it
759     * need not be freed, *freeProcPtr will be set to NULL; otherwise
760     * *freeProcPtr will be set to the address of a procedure to
761     * free the result, and the caller must invoke this procedure
762     * when it is finished with the result.
763     *
764     * Side effects:
765     * None.
766     *
767     *----------------------------------------------------------------------
768     */
769    
770     static char *
771     FormatConfigValue(interp, tkwin, specPtr, widgRec, buffer, freeProcPtr)
772     Tcl_Interp *interp; /* Interpreter for use in real conversions. */
773     Tk_Window tkwin; /* Window corresponding to widget. */
774     Tk_ConfigSpec *specPtr; /* Pointer to information describing option.
775     * Must not point to a synonym option. */
776     char *widgRec; /* Pointer to record holding current
777     * values of info for widget. */
778     char *buffer; /* Static buffer to use for small values.
779     * Must have at least 200 bytes of storage. */
780     Tcl_FreeProc **freeProcPtr; /* Pointer to word to fill in with address
781     * of procedure to free the result, or NULL
782     * if result is static. */
783     {
784     char *ptr, *result;
785    
786     *freeProcPtr = NULL;
787     ptr = widgRec + specPtr->offset;
788     result = "";
789     switch (specPtr->type) {
790     case TK_CONFIG_BOOLEAN:
791     if (*((int *) ptr) == 0) {
792     result = "0";
793     } else {
794     result = "1";
795     }
796     break;
797     case TK_CONFIG_INT:
798     sprintf(buffer, "%d", *((int *) ptr));
799     result = buffer;
800     break;
801     case TK_CONFIG_DOUBLE:
802     Tcl_PrintDouble(interp, *((double *) ptr), buffer);
803     result = buffer;
804     break;
805     case TK_CONFIG_STRING:
806     result = (*(char **) ptr);
807     if (result == NULL) {
808     result = "";
809     }
810     break;
811     case TK_CONFIG_UID: {
812     Tk_Uid uid = *((Tk_Uid *) ptr);
813     if (uid != NULL) {
814     result = uid;
815     }
816     break;
817     }
818     case TK_CONFIG_COLOR: {
819     XColor *colorPtr = *((XColor **) ptr);
820     if (colorPtr != NULL) {
821     result = Tk_NameOfColor(colorPtr);
822     }
823     break;
824     }
825     case TK_CONFIG_FONT: {
826     Tk_Font tkfont = *((Tk_Font *) ptr);
827     if (tkfont != NULL) {
828     result = Tk_NameOfFont(tkfont);
829     }
830     break;
831     }
832     case TK_CONFIG_BITMAP: {
833     Pixmap pixmap = *((Pixmap *) ptr);
834     if (pixmap != None) {
835     result = Tk_NameOfBitmap(Tk_Display(tkwin), pixmap);
836     }
837     break;
838     }
839     case TK_CONFIG_BORDER: {
840     Tk_3DBorder border = *((Tk_3DBorder *) ptr);
841     if (border != NULL) {
842     result = Tk_NameOf3DBorder(border);
843     }
844     break;
845     }
846     case TK_CONFIG_RELIEF:
847     result = Tk_NameOfRelief(*((int *) ptr));
848     break;
849     case TK_CONFIG_CURSOR:
850     case TK_CONFIG_ACTIVE_CURSOR: {
851     Tk_Cursor cursor = *((Tk_Cursor *) ptr);
852     if (cursor != None) {
853     result = Tk_NameOfCursor(Tk_Display(tkwin), cursor);
854     }
855     break;
856     }
857     case TK_CONFIG_JUSTIFY:
858     result = Tk_NameOfJustify(*((Tk_Justify *) ptr));
859     break;
860     case TK_CONFIG_ANCHOR:
861     result = Tk_NameOfAnchor(*((Tk_Anchor *) ptr));
862     break;
863     case TK_CONFIG_CAP_STYLE:
864     result = Tk_NameOfCapStyle(*((int *) ptr));
865     break;
866     case TK_CONFIG_JOIN_STYLE:
867     result = Tk_NameOfJoinStyle(*((int *) ptr));
868     break;
869     case TK_CONFIG_PIXELS:
870     sprintf(buffer, "%d", *((int *) ptr));
871     result = buffer;
872     break;
873     case TK_CONFIG_MM:
874     Tcl_PrintDouble(interp, *((double *) ptr), buffer);
875     result = buffer;
876     break;
877     case TK_CONFIG_WINDOW: {
878     Tk_Window tkwin;
879    
880     tkwin = *((Tk_Window *) ptr);
881     if (tkwin != NULL) {
882     result = Tk_PathName(tkwin);
883     }
884     break;
885     }
886     case TK_CONFIG_CUSTOM:
887     result = (*specPtr->customPtr->printProc)(
888     specPtr->customPtr->clientData, tkwin, widgRec,
889     specPtr->offset, freeProcPtr);
890     break;
891     default:
892     result = "?? unknown type ??";
893     }
894     return result;
895     }
896    
897     /*
898     *----------------------------------------------------------------------
899     *
900     * Tk_ConfigureValue --
901     *
902     * This procedure returns the current value of a configuration
903     * option for a widget.
904     *
905     * Results:
906     * The return value is a standard Tcl completion code (TCL_OK or
907     * TCL_ERROR). The interp's result will be set to hold either the value
908     * of the option given by argvName (if TCL_OK is returned) or
909     * an error message (if TCL_ERROR is returned).
910     *
911     * Side effects:
912     * None.
913     *
914     *----------------------------------------------------------------------
915     */
916    
917     int
918     Tk_ConfigureValue(interp, tkwin, specs, widgRec, argvName, flags)
919     Tcl_Interp *interp; /* Interpreter for error reporting. */
920     Tk_Window tkwin; /* Window corresponding to widgRec. */
921     Tk_ConfigSpec *specs; /* Describes legal options. */
922     char *widgRec; /* Record whose fields contain current
923     * values for options. */
924     char *argvName; /* Gives the command-line name for the
925     * option whose value is to be returned. */
926     int flags; /* Used to specify additional flags
927     * that must be present in config specs
928     * for them to be considered. */
929     {
930     Tk_ConfigSpec *specPtr;
931     int needFlags, hateFlags;
932    
933     needFlags = flags & ~(TK_CONFIG_USER_BIT - 1);
934     if (Tk_Depth(tkwin) <= 1) {
935     hateFlags = TK_CONFIG_COLOR_ONLY;
936     } else {
937     hateFlags = TK_CONFIG_MONO_ONLY;
938     }
939     specPtr = FindConfigSpec(interp, specs, argvName, needFlags, hateFlags);
940     if (specPtr == NULL) {
941     return TCL_ERROR;
942     }
943     interp->result = FormatConfigValue(interp, tkwin, specPtr, widgRec,
944     interp->result, &interp->freeProc);
945     return TCL_OK;
946     }
947    
948     /*
949     *----------------------------------------------------------------------
950     *
951     * Tk_FreeOptions --
952     *
953     * Free up all resources associated with configuration options.
954     *
955     * Results:
956     * None.
957     *
958     * Side effects:
959     * Any resource in widgRec that is controlled by a configuration
960     * option (e.g. a Tk_3DBorder or XColor) is freed in the appropriate
961     * fashion.
962     *
963     *----------------------------------------------------------------------
964     */
965    
966     /* ARGSUSED */
967     void
968     Tk_FreeOptions(specs, widgRec, display, needFlags)
969     Tk_ConfigSpec *specs; /* Describes legal options. */
970     char *widgRec; /* Record whose fields contain current
971     * values for options. */
972     Display *display; /* X display; needed for freeing some
973     * resources. */
974     int needFlags; /* Used to specify additional flags
975     * that must be present in config specs
976     * for them to be considered. */
977     {
978     register Tk_ConfigSpec *specPtr;
979     char *ptr;
980    
981     for (specPtr = specs; specPtr->type != TK_CONFIG_END; specPtr++) {
982     if ((specPtr->specFlags & needFlags) != needFlags) {
983     continue;
984     }
985     ptr = widgRec + specPtr->offset;
986     switch (specPtr->type) {
987     case TK_CONFIG_STRING:
988     if (*((char **) ptr) != NULL) {
989     ckfree(*((char **) ptr));
990     *((char **) ptr) = NULL;
991     }
992     break;
993     case TK_CONFIG_COLOR:
994     if (*((XColor **) ptr) != NULL) {
995     Tk_FreeColor(*((XColor **) ptr));
996     *((XColor **) ptr) = NULL;
997     }
998     break;
999     case TK_CONFIG_FONT:
1000     Tk_FreeFont(*((Tk_Font *) ptr));
1001     *((Tk_Font *) ptr) = NULL;
1002     break;
1003     case TK_CONFIG_BITMAP:
1004     if (*((Pixmap *) ptr) != None) {
1005     Tk_FreeBitmap(display, *((Pixmap *) ptr));
1006     *((Pixmap *) ptr) = None;
1007     }
1008     break;
1009     case TK_CONFIG_BORDER:
1010     if (*((Tk_3DBorder *) ptr) != NULL) {
1011     Tk_Free3DBorder(*((Tk_3DBorder *) ptr));
1012     *((Tk_3DBorder *) ptr) = NULL;
1013     }
1014     break;
1015     case TK_CONFIG_CURSOR:
1016     case TK_CONFIG_ACTIVE_CURSOR:
1017     if (*((Tk_Cursor *) ptr) != None) {
1018     Tk_FreeCursor(display, *((Tk_Cursor *) ptr));
1019     *((Tk_Cursor *) ptr) = None;
1020     }
1021     }
1022     }
1023     }
1024    
1025 dashley 69 /* End of tkoldconfig.c */

Properties

Name Value
svn:keywords Header

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25