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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 69 - (show annotations) (download)
Sat Nov 5 10:54:17 2016 UTC (6 years, 3 months ago) by dashley
File MIME type: text/plain
File size: 29238 byte(s)
License and property (keyword) changes.
1 /* $Header$ */
2
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 /* End of tkoldconfig.c */

Properties

Name Value
svn:keywords Header

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25