source: trunk/kitgen/8.x/blt/generic/bltObjConfig.c@ 201

Last change on this file since 201 was 175, checked in by demin, 12 years ago

initial commit
File size: 61.4 KB
Line 
1/*
2 * bltObjConfig.c --
3 *
4 * This file contains the Tk_ConfigureWidget procedure. THIS FILE
5 * IS HERE FOR BACKWARD COMPATIBILITY; THE NEW CONFIGURATION
6 * PACKAGE SHOULD BE USED FOR NEW PROJECTS.
7 *
8 * Copyright (c) 1990-1994 The Regents of the University of California.
9 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
10 *
11 * See the file "license.terms" for information on usage and redistribution
12 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
13 *
14 * RCS: @(#) $Id: bltObjConfig.c,v 1.22 2002/09/18 22:30:51 ghowlett Exp $
15 */
16
17#include "bltInt.h"
18#if (TK_VERSION_NUMBER >= _VERSION(8,0,0))
19#if defined(__STDC__)
20#include <stdarg.h>
21#else
22#include <varargs.h>
23#endif
24#include "bltObjConfig.h"
25#include "bltTile.h"
26
27#if (TK_VERSION_NUMBER < _VERSION(8,1,0))
28/*
29 *----------------------------------------------------------------------
30 *
31 * Tk_GetAnchorFromObj --
32 *
33 * Return a Tk_Anchor value based on the value of the objPtr.
34 *
35 * Results:
36 * The return value is a standard Tcl result. If an error occurs during
37 * conversion, an error message is left in the interpreter's result
38 * unless "interp" is NULL.
39 *
40 * Side effects:
41 * The object gets converted by Tcl_GetIndexFromObj.
42 *
43 *----------------------------------------------------------------------
44 */
45int
46Tk_GetAnchorFromObj(interp, objPtr, anchorPtr)
47 Tcl_Interp *interp; /* Used for error reporting. */
48 Tcl_Obj *objPtr; /* The object we are trying to get the
49 * value from. */
50 Tk_Anchor *anchorPtr; /* Where to place the Tk_Anchor that
51 * corresponds to the string value of
52 * objPtr. */
53{
54 return Tk_GetAnchor(interp, Tcl_GetString(objPtr), anchorPtr);
55}
56
57/*
58 *----------------------------------------------------------------------
59 *
60 * Tk_GetJustifyFromObj --
61 *
62 * Return a Tk_Justify value based on the value of the objPtr.
63 *
64 * Results:
65 * The return value is a standard Tcl result. If an error occurs during
66 * conversion, an error message is left in the interpreter's result
67 * unless "interp" is NULL.
68 *
69 * Side effects:
70 * The object gets converted by Tcl_GetIndexFromObj.
71 *
72 *----------------------------------------------------------------------
73 */
74int
75Tk_GetJustifyFromObj(interp, objPtr, justifyPtr)
76 Tcl_Interp *interp; /* Used for error reporting. */
77 Tcl_Obj *objPtr; /* The object we are trying to get the
78 * value from. */
79 Tk_Justify *justifyPtr; /* Where to place the Tk_Justify that
80 * corresponds to the string value of
81 * objPtr. */
82{
83 return Tk_GetJustify(interp, Tcl_GetString(objPtr), justifyPtr);
84}
85/*
86 *----------------------------------------------------------------------
87 *
88 * Tk_GetReliefFromObj --
89 *
90 * Return an integer value based on the value of the objPtr.
91 *
92 * Results:
93 * The return value is a standard Tcl result. If an error occurs during
94 * conversion, an error message is left in the interpreter's result
95 * unless "interp" is NULL.
96 *
97 * Side effects:
98 * The object gets converted by Tcl_GetIndexFromObj.
99 *
100 *----------------------------------------------------------------------
101 */
102int
103Tk_GetReliefFromObj(interp, objPtr, reliefPtr)
104 Tcl_Interp *interp; /* Used for error reporting. */
105 Tcl_Obj *objPtr; /* The object we are trying to get the
106 * value from. */
107 int *reliefPtr; /* Where to place the answer. */
108{
109 return Tk_GetRelief(interp, Tcl_GetString(objPtr), reliefPtr);
110}
111/*
112 *----------------------------------------------------------------------
113 *
114 * Tk_GetMMFromObj --
115 *
116 * Attempt to return an mm value from the Tcl object "objPtr". If the
117 * object is not already an mm value, an attempt will be made to convert
118 * it to one.
119 *
120 * Results:
121 * The return value is a standard Tcl object result. If an error occurs
122 * during conversion, an error message is left in the interpreter's
123 * result unless "interp" is NULL.
124 *
125 * Side effects:
126 * If the object is not already a pixel, the conversion will free
127 * any old internal representation.
128 *
129 *----------------------------------------------------------------------
130 */
131int
132Tk_GetMMFromObj(interp, tkwin, objPtr, doublePtr)
133 Tcl_Interp *interp; /* Used for error reporting if not NULL. */
134 Tk_Window tkwin;
135 Tcl_Obj *objPtr; /* The object from which to get mms. */
136 double *doublePtr; /* Place to store resulting millimeters. */
137{
138 return Tk_GetScreenMM(interp, tkwin, Tcl_GetString(objPtr), doublePtr);
139}
140/*
141 *----------------------------------------------------------------------
142 *
143 * Tk_GetPixelsFromObj --
144 *
145 * Attempt to return a pixel value from the Tcl object "objPtr". If the
146 * object is not already a pixel value, an attempt will be made to convert
147 * it to one.
148 *
149 * Results:
150 * The return value is a standard Tcl object result. If an error occurs
151 * during conversion, an error message is left in the interpreter's
152 * result unless "interp" is NULL.
153 *
154 * Side effects:
155 * If the object is not already a pixel, the conversion will free
156 * any old internal representation.
157 *
158 *----------------------------------------------------------------------
159 */
160int
161Tk_GetPixelsFromObj(interp, tkwin, objPtr, intPtr)
162 Tcl_Interp *interp; /* Used for error reporting if not NULL. */
163 Tk_Window tkwin;
164 Tcl_Obj *objPtr; /* The object from which to get pixels. */
165 int *intPtr; /* Place to store resulting pixels. */
166{
167 return Tk_GetPixels(interp, tkwin, Tcl_GetString(objPtr), intPtr);
168}
169
170/*
171 *----------------------------------------------------------------------
172 *
173 * Tk_Alloc3DBorderFromObj --
174 *
175 * Given a Tcl_Obj *, map the value to a corresponding
176 * Tk_3DBorder structure based on the tkwin given.
177 *
178 * Results:
179 * The return value is a token for a data structure describing a
180 * 3-D border. This token may be passed to procedures such as
181 * Blt_Draw3DRectangle and Tk_Free3DBorder. If an error prevented
182 * the border from being created then NULL is returned and an error
183 * message will be left in the interp's result.
184 *
185 * Side effects:
186 * The border is added to an internal database with a reference
187 * count. For each call to this procedure, there should eventually
188 * be a call to FreeBorderObjProc so that the database is
189 * cleaned up when borders aren't in use anymore.
190 *
191 *----------------------------------------------------------------------
192 */
193Tk_3DBorder
194Tk_Alloc3DBorderFromObj(interp, tkwin, objPtr)
195 Tcl_Interp *interp; /* Interp for error results. */
196 Tk_Window tkwin; /* Need the screen the border is used on.*/
197 Tcl_Obj *objPtr; /* Object giving name of color for window
198 * background. */
199{
200 return Tk_Get3DBorder(interp, tkwin, Tcl_GetString(objPtr));
201}
202/*
203 *----------------------------------------------------------------------
204 *
205 * Tk_AllocBitmapFromObj --
206 *
207 * Given a Tcl_Obj *, map the value to a corresponding
208 * Pixmap structure based on the tkwin given.
209 *
210 * Results:
211 * The return value is the X identifer for the desired bitmap
212 * (i.e. a Pixmap with a single plane), unless string couldn't be
213 * parsed correctly. In this case, None is returned and an error
214 * message is left in the interp's result. The caller should never
215 * modify the bitmap that is returned, and should eventually call
216 * Tk_FreeBitmapFromObj when the bitmap is no longer needed.
217 *
218 * Side effects:
219 * The bitmap is added to an internal database with a reference count.
220 * For each call to this procedure, there should eventually be a call
221 * to Tk_FreeBitmapFromObj, so that the database can be cleaned up
222 * when bitmaps aren't needed anymore.
223 *
224 *----------------------------------------------------------------------
225 */
226Pixmap
227Tk_AllocBitmapFromObj(interp, tkwin, objPtr)
228 Tcl_Interp *interp; /* Interp for error results. This may
229 * be NULL. */
230 Tk_Window tkwin; /* Need the screen the bitmap is used on.*/
231 Tcl_Obj *objPtr; /* Object describing bitmap; see manual
232 * entry for legal syntax of string value. */
233{
234 return Tk_GetBitmap(interp, tkwin, Tcl_GetString(objPtr));
235}
236
237/*
238 *---------------------------------------------------------------------------
239 *
240 * Tk_AllocFontFromObj --
241 *
242 * Given a string description of a font, map the description to a
243 * corresponding Tk_Font that represents the font.
244 *
245 * Results:
246 * The return value is token for the font, or NULL if an error
247 * prevented the font from being created. If NULL is returned, an
248 * error message will be left in interp's result object.
249 *
250 * Side effects:
251 * The font is added to an internal database with a reference
252 * count. For each call to this procedure, there should eventually
253 * be a call to Tk_FreeFont() or Tk_FreeFontFromObj() so that the
254 * database is cleaned up when fonts aren't in use anymore.
255 *
256 *---------------------------------------------------------------------------
257 */
258Tk_Font
259Tk_AllocFontFromObj(interp, tkwin, objPtr)
260 Tcl_Interp *interp; /* Interp for database and error return. */
261 Tk_Window tkwin; /* For screen on which font will be used. */
262 Tcl_Obj *objPtr; /* Object describing font, as: named font,
263 * native format, or parseable string. */
264{
265 return Tk_GetFont(interp, tkwin, Tcl_GetString(objPtr));
266}
267
268/*
269 *----------------------------------------------------------------------
270 *
271 * Tk_AllocCursorFromObj --
272 *
273 * Given a Tcl_Obj *, map the value to a corresponding
274 * Tk_Cursor structure based on the tkwin given.
275 *
276 * Results:
277 * The return value is the X identifer for the desired cursor,
278 * unless objPtr couldn't be parsed correctly. In this case,
279 * None is returned and an error message is left in the interp's result.
280 * The caller should never modify the cursor that is returned, and
281 * should eventually call Tk_FreeCursorFromObj when the cursor is no
282 * longer needed.
283 *
284 * Side effects:
285 * The cursor is added to an internal database with a reference count.
286 * For each call to this procedure, there should eventually be a call
287 * to Tk_FreeCursorFromObj, so that the database can be cleaned up
288 * when cursors aren't needed anymore.
289 *
290 *----------------------------------------------------------------------
291 */
292Tk_Cursor
293Tk_AllocCursorFromObj(interp, tkwin, objPtr)
294 Tcl_Interp *interp; /* Interp for error results. */
295 Tk_Window tkwin; /* Window in which the cursor will be used.*/
296 Tcl_Obj *objPtr; /* Object describing cursor; see manual
297 * entry for description of legal
298 * syntax of this obj's string rep. */
299{
300 return Tk_GetCursor(interp, tkwin, Tcl_GetString(objPtr));
301}
302
303/*
304 *----------------------------------------------------------------------
305 *
306 * Tk_AllocColorFromObj --
307 *
308 * Given a Tcl_Obj *, map the value to a corresponding
309 * XColor structure based on the tkwin given.
310 *
311 * Results:
312 * The return value is a pointer to an XColor structure that
313 * indicates the red, blue, and green intensities for the color
314 * given by the string in objPtr, and also specifies a pixel value
315 * to use to draw in that color. If an error occurs, NULL is
316 * returned and an error message will be left in interp's result
317 * (unless interp is NULL).
318 *
319 * Side effects:
320 * The color is added to an internal database with a reference count.
321 * For each call to this procedure, there should eventually be a call
322 * to Tk_FreeColorFromObj so that the database is cleaned up when colors
323 * aren't in use anymore.
324 *
325 *----------------------------------------------------------------------
326 */
327XColor *
328Tk_AllocColorFromObj(interp, tkwin, objPtr)
329 Tcl_Interp *interp; /* Used only for error reporting. If NULL,
330 * then no messages are provided. */
331 Tk_Window tkwin; /* Window in which the color will be used.*/
332 Tcl_Obj *objPtr; /* Object that describes the color; string
333 * value is a color name such as "red" or
334 * "#ff0000".*/
335{
336 char *string;
337
338 string = Tcl_GetString(objPtr);
339 return Tk_GetColor(interp, tkwin, Tk_GetUid(string));
340}
341
342#endif /* 8.0 */
343
344/*
345 *--------------------------------------------------------------
346 *
347 * Blt_GetPosition --
348 *
349 * Convert a string representing a numeric position.
350 * A position can be in one of the following forms.
351 *
352 * number - number of the item in the hierarchy, indexed
353 * from zero.
354 * "end" - last position in the hierarchy.
355 *
356 * Results:
357 * A standard Tcl result. If "string" is a valid index, then
358 * *indexPtr is filled with the corresponding numeric index.
359 * If "end" was selected then *indexPtr is set to -1.
360 * Otherwise an error message is left in interp->result.
361 *
362 * Side effects:
363 * None.
364 *
365 *--------------------------------------------------------------
366 */
367int
368Blt_GetPositionFromObj(interp, objPtr, indexPtr)
369 Tcl_Interp *interp; /* Interpreter to report results back
370 * to. */
371 Tcl_Obj *objPtr; /* Tcl_Obj representation of the index.
372 * Can be an integer or "end" to refer
373 * to the last index. */
374 int *indexPtr; /* Holds the converted index. */
375{
376 char *string;
377
378 string = Tcl_GetString(objPtr);
379 if ((string[0] == 'e') && (strcmp(string, "end") == 0)) {
380 *indexPtr = -1; /* Indicates last position in hierarchy. */
381 } else {
382 int position;
383
384 if (Tcl_GetIntFromObj(interp, objPtr, &position) != TCL_OK) {
385 return TCL_ERROR;
386 }
387 if (position < 0) {
388 Tcl_AppendResult(interp, "bad position \"", string, "\"",
389 (char *)NULL);
390 return TCL_ERROR;
391 }
392 *indexPtr = position;
393 }
394 return TCL_OK;
395}
396
397/*
398 *----------------------------------------------------------------------
399 *
400 * Blt_GetPixelsFromObj --
401 *
402 * Like Tk_GetPixelsFromObj, but checks for negative, zero.
403 *
404 * Results:
405 * A standard Tcl result.
406 *
407 *----------------------------------------------------------------------
408 */
409int
410Blt_GetPixelsFromObj(interp, tkwin, objPtr, check, valuePtr)
411 Tcl_Interp *interp;
412 Tk_Window tkwin;
413 Tcl_Obj *objPtr;
414 int check; /* Can be PIXELS_POSITIVE, PIXELS_NONNEGATIVE,
415 * or PIXELS_ANY, */
416 int *valuePtr;
417{
418 int length;
419
420 if (Tk_GetPixelsFromObj(interp, tkwin, objPtr, &length) != TCL_OK) {
421 return TCL_ERROR;
422 }
423 if (length >= SHRT_MAX) {
424 Tcl_AppendResult(interp, "bad distance \"", Tcl_GetString(objPtr),
425 "\": too big to represent", (char *)NULL);
426 return TCL_ERROR;
427 }
428 switch (check) {
429 case PIXELS_NONNEGATIVE:
430 if (length < 0) {
431 Tcl_AppendResult(interp, "bad distance \"", Tcl_GetString(objPtr),
432 "\": can't be negative", (char *)NULL);
433 return TCL_ERROR;
434 }
435 break;
436
437 case PIXELS_POSITIVE:
438 if (length <= 0) {
439 Tcl_AppendResult(interp, "bad distance \"", Tcl_GetString(objPtr),
440 "\": must be positive", (char *)NULL);
441 return TCL_ERROR;
442 }
443 break;
444
445 case PIXELS_ANY:
446 break;
447 }
448 *valuePtr = length;
449 return TCL_OK;
450}
451
452int
453Blt_GetPadFromObj(interp, tkwin, objPtr, padPtr)
454 Tcl_Interp *interp; /* Interpreter to send results back to */
455 Tk_Window tkwin; /* Window */
456 Tcl_Obj *objPtr; /* Pixel value string */
457 Blt_Pad *padPtr;
458{
459 int side1, side2;
460 int objc;
461 Tcl_Obj **objv;
462
463 if (Tcl_ListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK) {
464 return TCL_ERROR;
465 }
466 if ((objc < 1) || (objc > 2)) {
467 Tcl_AppendResult(interp, "wrong # elements in padding list",
468 (char *)NULL);
469 return TCL_ERROR;
470 }
471 if (Blt_GetPixelsFromObj(interp, tkwin, objv[0], PIXELS_NONNEGATIVE,
472 &side1) != TCL_OK) {
473 return TCL_ERROR;
474 }
475 side2 = side1;
476 if ((objc > 1) &&
477 (Blt_GetPixelsFromObj(interp, tkwin, objv[1], PIXELS_NONNEGATIVE,
478 &side2) != TCL_OK)) {
479 return TCL_ERROR;
480 }
481 /* Don't update the pad structure until we know both values are okay. */
482 padPtr->side1 = side1;
483 padPtr->side2 = side2;
484 return TCL_OK;
485}
486
487int
488Blt_GetShadowFromObj(interp, tkwin, objPtr, shadowPtr)
489 Tcl_Interp *interp; /* Interpreter to send results back to */
490 Tk_Window tkwin; /* Window */
491 Tcl_Obj *objPtr; /* Pixel value string */
492 Shadow *shadowPtr;
493{
494 XColor *colorPtr;
495 int dropOffset;
496 int objc;
497 Tcl_Obj **objv;
498
499 if (Tcl_ListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK) {
500 return TCL_ERROR;
501 }
502 if (objc > 2) {
503 Tcl_AppendResult(interp, "wrong # elements in drop shadow value",
504 (char *)NULL);
505 return TCL_ERROR;
506 }
507 dropOffset = 0;
508 colorPtr = NULL;
509 if (objc > 0) {
510 colorPtr = Tk_AllocColorFromObj(interp, tkwin, objv[0]);
511 if (colorPtr == NULL) {
512 return TCL_ERROR;
513 }
514 dropOffset = 1;
515 if (objc == 2) {
516 if (Blt_GetPixelsFromObj(interp, tkwin, objv[1], PIXELS_NONNEGATIVE,
517 &dropOffset) != TCL_OK) {
518 Tk_FreeColor(colorPtr);
519 return TCL_ERROR;
520 }
521 }
522 }
523 if (shadowPtr->color != NULL) {
524 Tk_FreeColor(shadowPtr->color);
525 }
526 shadowPtr->color = colorPtr;
527 shadowPtr->offset = dropOffset;
528 return TCL_OK;
529}
530
531int
532Blt_GetStateFromObj(interp, objPtr, statePtr)
533 Tcl_Interp *interp; /* Interpreter to send results back to */
534 Tcl_Obj *objPtr; /* Pixel value string */
535 int *statePtr;
536{
537 char *string;
538
539 string = Tcl_GetString(objPtr);
540 if (strcmp(string, "normal") == 0) {
541 *statePtr = STATE_NORMAL;
542 } else if (strcmp(string, "disabled") == 0) {
543 *statePtr = STATE_DISABLED;
544 } else if (strcmp(string, "active") == 0) {
545 *statePtr = STATE_ACTIVE;
546 } else {
547 Tcl_AppendResult(interp, "bad state \"", string,
548 "\": should be normal, active, or disabled", (char *)NULL);
549 return TCL_ERROR;
550 }
551 return TCL_OK;
552}
553
554char *
555Blt_NameOfState(state)
556 int state;
557{
558 switch (state) {
559 case STATE_ACTIVE:
560 return "active";
561 case STATE_DISABLED:
562 return "disabled";
563 case STATE_NORMAL:
564 return "normal";
565 default:
566 return "???";
567 }
568}
569
570#ifdef notdef /* Replace this routine when Tcl_Obj-based
571 * configuration comes on-line */
572
573/*
574 *----------------------------------------------------------------------
575 *
576 * Blt_NameOfFill --
577 *
578 * Converts the integer representing the fill style into a string.
579 *
580 *----------------------------------------------------------------------
581 */
582char *
583Blt_NameOfFill(fill)
584 int fill;
585{
586 switch (fill) {
587 case FILL_X:
588 return "x";
589 case FILL_Y:
590 return "y";
591 case FILL_NONE:
592 return "none";
593 case FILL_BOTH:
594 return "both";
595 default:
596 return "unknown value";
597 }
598}
599#endif
600
601/*
602 *----------------------------------------------------------------------
603 *
604 * Blt_GetFillFromObj --
605 *
606 * Converts the fill style string into its numeric representation.
607 *
608 * Valid style strings are:
609 *
610 * "none" Use neither plane.
611 * "x" X-coordinate plane.
612 * "y" Y-coordinate plane.
613 * "both" Use both coordinate planes.
614 *
615 *----------------------------------------------------------------------
616 */
617/*ARGSUSED*/
618int
619Blt_GetFillFromObj(interp, objPtr, fillPtr)
620 Tcl_Interp *interp; /* Interpreter to send results back to */
621 Tcl_Obj *objPtr; /* Fill style string */
622 int *fillPtr;
623{
624 int length;
625 char c;
626 char *string;
627
628 string = Tcl_GetStringFromObj(objPtr, &length);
629 c = string[0];
630 if ((c == 'n') && (strncmp(string, "none", length) == 0)) {
631 *fillPtr = FILL_NONE;
632 } else if ((c == 'x') && (strncmp(string, "x", length) == 0)) {
633 *fillPtr = FILL_X;
634 } else if ((c == 'y') && (strncmp(string, "y", length) == 0)) {
635 *fillPtr = FILL_Y;
636 } else if ((c == 'b') && (strncmp(string, "both", length) == 0)) {
637 *fillPtr = FILL_BOTH;
638 } else {
639 Tcl_AppendResult(interp, "bad argument \"", string,
640 "\": should be \"none\", \"x\", \"y\", or \"both\"", (char *)NULL);
641 return TCL_ERROR;
642 }
643 return TCL_OK;
644}
645
646/*
647 *----------------------------------------------------------------------
648 *
649 * Blt_GetDashesFromObj --
650 *
651 * Converts a Tcl list of dash values into a dash list ready for
652 * use with XSetDashes.
653 *
654 * A valid list dash values can have zero through 11 elements
655 * (PostScript limit). Values must be between 1 and 255. Although
656 * a list of 0 (like the empty string) means no dashes.
657 *
658 * Results:
659 * A standard Tcl result. If the list represented a valid dash
660 * list TCL_OK is returned and *dashesPtr* will contain the
661 * valid dash list. Otherwise, TCL_ERROR is returned and
662 * interp->result will contain an error message.
663 *
664 *
665 *----------------------------------------------------------------------
666 */
667int
668Blt_GetDashesFromObj(interp, objPtr, dashesPtr)
669 Tcl_Interp *interp;
670 Tcl_Obj *objPtr;
671 Blt_Dashes *dashesPtr;
672{
673 char *string;
674
675 string = Tcl_GetString(objPtr);
676 if ((string == NULL) || (*string == '\0')) {
677 dashesPtr->values[0] = 0;
678 } else if (strcmp(string, "dash") == 0) { /* 5 2 */
679 dashesPtr->values[0] = 5;
680 dashesPtr->values[1] = 2;
681 dashesPtr->values[2] = 0;
682 } else if (strcmp(string, "dot") == 0) { /* 1 */
683 dashesPtr->values[0] = 1;
684 dashesPtr->values[1] = 0;
685 } else if (strcmp(string, "dashdot") == 0) { /* 2 4 2 */
686 dashesPtr->values[0] = 2;
687 dashesPtr->values[1] = 4;
688 dashesPtr->values[2] = 2;
689 dashesPtr->values[3] = 0;
690 } else if (strcmp(string, "dashdotdot") == 0) { /* 2 4 2 2 */
691 dashesPtr->values[0] = 2;
692 dashesPtr->values[1] = 4;
693 dashesPtr->values[2] = 2;
694 dashesPtr->values[3] = 2;
695 dashesPtr->values[4] = 0;
696 } else {
697 int objc;
698 Tcl_Obj **objv;
699 int value;
700 register int i;
701
702 if (Tcl_ListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK) {
703 return TCL_ERROR;
704 }
705 if (objc > 11) { /* This is the postscript limit */
706 Tcl_AppendResult(interp, "too many values in dash list \"",
707 string, "\"", (char *)NULL);
708 return TCL_ERROR;
709 }
710 for (i = 0; i < objc; i++) {
711 if (Tcl_GetIntFromObj(interp, objv[i], &value) != TCL_OK) {
712 return TCL_ERROR;
713 }
714 /*
715 * Backward compatibility:
716 * Allow list of 0 to turn off dashes
717 */
718 if ((value == 0) && (objc == 1)) {
719 break;
720 }
721 if ((value < 1) || (value > 255)) {
722 Tcl_AppendResult(interp, "dash value \"",
723 Tcl_GetString(objv[i]), "\" is out of range",
724 (char *)NULL);
725 return TCL_ERROR;
726 }
727 dashesPtr->values[i] = (unsigned char)value;
728 }
729 /* Make sure the array ends with a NUL byte */
730 dashesPtr->values[i] = 0;
731 }
732 return TCL_OK;
733}
734
735char *
736Blt_NameOfSide(side)
737 int side;
738{
739 switch (side) {
740 case SIDE_LEFT:
741 return "left";
742 case SIDE_RIGHT:
743 return "right";
744 case SIDE_BOTTOM:
745 return "bottom";
746 case SIDE_TOP:
747 return "top";
748 }
749 return "unknown side value";
750}
751
752/*
753 *----------------------------------------------------------------------
754 *
755 * Blt_GetSideFromObj --
756 *
757 * Converts the fill style string into its numeric representation.
758 *
759 * Valid style strings are "left", "right", "top", or "bottom".
760 *
761 *----------------------------------------------------------------------
762 */
763/*ARGSUSED */
764int
765Blt_GetSideFromObj(interp, objPtr, sidePtr)
766 Tcl_Interp *interp; /* Interpreter to send results back to */
767 Tcl_Obj *objPtr; /* Value string */
768 int *sidePtr; /* (out) Token representing side:
769 * either SIDE_LEFT, SIDE_RIGHT,
770 * SIDE_TOP, or SIDE_BOTTOM. */
771{
772 char c;
773 int length;
774 char *string;
775
776 string = Tcl_GetStringFromObj(objPtr, &length);
777 c = string[0];
778 if ((c == 'l') && (strncmp(string, "left", length) == 0)) {
779 *sidePtr = SIDE_LEFT;
780 } else if ((c == 'r') && (strncmp(string, "right", length) == 0)) {
781 *sidePtr = SIDE_RIGHT;
782 } else if ((c == 't') && (strncmp(string, "top", length) == 0)) {
783 *sidePtr = SIDE_TOP;
784 } else if ((c == 'b') && (strncmp(string, "bottom", length) == 0)) {
785 *sidePtr = SIDE_BOTTOM;
786 } else {
787 Tcl_AppendResult(interp, "bad side \"", string,
788 "\": should be left, right, top, or bottom", (char *)NULL);
789 return TCL_ERROR;
790 }
791 return TCL_OK;
792}
793
794/*
795 *----------------------------------------------------------------------
796 *
797 * Blt_StringToEnum --
798 *
799 * Converts the string into its enumerated type.
800 *
801 *----------------------------------------------------------------------
802 */
803/*ARGSUSED*/
804int
805Blt_ObjToEnum(clientData, interp, tkwin, objPtr, widgRec, offset)
806 ClientData clientData; /* Vectors of valid strings. */
807 Tcl_Interp *interp; /* Interpreter to send results back to */
808 Tk_Window tkwin; /* Not used. */
809 Tcl_Obj *objPtr;
810 char *widgRec; /* Widget record. */
811 int offset; /* Offset of field in record */
812{
813 int *enumPtr = (int *)(widgRec + offset);
814 char c;
815 register char **p;
816 register int i;
817 int count;
818 char *string;
819
820 string = Tcl_GetString(objPtr);
821 c = string[0];
822 count = 0;
823 for (p = (char **)clientData; *p != NULL; p++) {
824 if ((c == p[0][0]) && (strcmp(string, *p) == 0)) {
825 *enumPtr = count;
826 return TCL_OK;
827 }
828 count++;
829 }
830 *enumPtr = -1;
831
832 Tcl_AppendResult(interp, "bad value \"", string, "\": should be ",
833 (char *)NULL);
834 p = (char **)clientData;
835 if (count > 0) {
836 Tcl_AppendResult(interp, p[0], (char *)NULL);
837 }
838 for (i = 1; i < (count - 1); i++) {
839 Tcl_AppendResult(interp, " ", p[i], ", ", (char *)NULL);
840 }
841 if (count > 1) {
842 Tcl_AppendResult(interp, " or ", p[count - 1], ".", (char *)NULL);
843 }
844 return TCL_ERROR;
845}
846
847/*
848 *----------------------------------------------------------------------
849 *
850 * Blt_EnumToObj --
851 *
852 * Returns the string associated with the enumerated type.
853 *
854 *----------------------------------------------------------------------
855 */
856/*ARGSUSED*/
857Tcl_Obj *
858Blt_EnumToObj(clientData, interp, tkwin, widgRec, offset)
859 ClientData clientData; /* List of strings. */
860 Tcl_Interp *interp;
861 Tk_Window tkwin; /* Not used. */
862 char *widgRec; /* Widget record */
863 int offset; /* Offset of field in widget record */
864{
865 int value = *(int *)(widgRec + offset);
866 char **strings = (char **)clientData;
867 char **p;
868 int count;
869
870 count = 0;
871 for (p = strings; *p != NULL; p++) {
872 if (value == count) {
873 return Tcl_NewStringObj(*p, -1);
874 }
875 count++;
876 }
877 return Tcl_NewStringObj("unknown value", -1);
878}
879
880/* Configuration option helper routines */
881
882/*
883 *--------------------------------------------------------------
884 *
885 * DoConfig --
886 *
887 * This procedure applies a single configuration option
888 * to a widget record.
889 *
890 * Results:
891 * A standard Tcl return value.
892 *
893 * Side effects:
894 * WidgRec is modified as indicated by specPtr and value.
895 * The old value is recycled, if that is appropriate for
896 * the value type.
897 *
898 *--------------------------------------------------------------
899 */
900static int
901DoConfig(interp, tkwin, specPtr, objPtr, widgRec)
902 Tcl_Interp *interp; /* Interpreter for error reporting. */
903 Tk_Window tkwin; /* Window containing widget (needed to
904 * set up X resources). */
905 Blt_ConfigSpec *specPtr; /* Specifier to apply. */
906 Tcl_Obj *objPtr; /* Value to use to fill in widgRec. */
907 char *widgRec; /* Record whose fields are to be
908 * modified. Values must be properly
909 * initialized. */
910{
911 char *ptr;
912 int objIsEmpty;
913
914 objIsEmpty = FALSE;
915 if (objPtr == NULL) {
916 objIsEmpty = TRUE;
917 } else if (specPtr->specFlags & BLT_CONFIG_NULL_OK) {
918 int length;
919
920 if (objPtr->bytes != NULL) {
921 length = objPtr->length;
922 } else {
923 Tcl_GetStringFromObj(objPtr, &length);
924 }
925 objIsEmpty = (length == 0);
926 }
927 do {
928 ptr = widgRec + specPtr->offset;
929 switch (specPtr->type) {
930 case BLT_CONFIG_ANCHOR:
931 {
932 Tk_Anchor anchor;
933
934 if (Tk_GetAnchorFromObj(interp, objPtr, &anchor) != TCL_OK) {
935 return TCL_ERROR;
936 }
937 *(Tk_Anchor *)ptr = anchor;
938 }
939 break;
940
941 case BLT_CONFIG_BITMAP:
942 {
943 Pixmap newBitmap, oldBitmap;
944
945 if (objIsEmpty) {
946 newBitmap = None;
947 } else {
948 newBitmap = Tk_AllocBitmapFromObj(interp, tkwin, objPtr);
949 if (newBitmap == None) {
950 return TCL_ERROR;
951 }
952 }
953 oldBitmap = *(Pixmap *)ptr;
954 if (oldBitmap != None) {
955 Tk_FreeBitmap(Tk_Display(tkwin), oldBitmap);
956 }
957 *(Pixmap *)ptr = newBitmap;
958 }
959 break;
960
961 case BLT_CONFIG_BOOLEAN:
962 {
963 int newBool;
964
965 if (Tcl_GetBooleanFromObj(interp, objPtr, &newBool)
966 != TCL_OK) {
967 return TCL_ERROR;
968 }
969 *(int *)ptr = newBool;
970 }
971 break;
972
973 case BLT_CONFIG_BORDER:
974 {
975 Tk_3DBorder newBorder, oldBorder;
976
977 if (objIsEmpty) {
978 newBorder = NULL;
979 } else {
980 newBorder = Tk_Alloc3DBorderFromObj(interp, tkwin, objPtr);
981 if (newBorder == NULL) {
982 return TCL_ERROR;
983 }
984 }
985 oldBorder = *(Tk_3DBorder *)ptr;
986 if (oldBorder != NULL) {
987 Tk_Free3DBorder(oldBorder);
988 }
989 *(Tk_3DBorder *)ptr = newBorder;
990 }
991 break;
992
993 case BLT_CONFIG_CAP_STYLE:
994 {
995 int cap;
996 Tk_Uid value;
997
998 value = Tk_GetUid(Tcl_GetString(objPtr));
999 if (Tk_GetCapStyle(interp, value, &cap) != TCL_OK) {
1000 return TCL_ERROR;
1001 }
1002 *(int *)ptr = cap;
1003 }
1004 break;
1005
1006 case BLT_CONFIG_COLOR:
1007 {
1008 XColor *newColor, *oldColor;
1009
1010 if (objIsEmpty) {
1011 newColor = NULL;
1012 } else {
1013 newColor = Tk_AllocColorFromObj(interp, tkwin, objPtr);
1014 if (newColor == NULL) {
1015 return TCL_ERROR;
1016 }
1017 }
1018 oldColor = *(XColor **)ptr;
1019 if (oldColor != NULL) {
1020 Tk_FreeColor(oldColor);
1021 }
1022 *(XColor **)ptr = newColor;
1023 }
1024 break;
1025
1026 case BLT_CONFIG_CURSOR:
1027 case BLT_CONFIG_ACTIVE_CURSOR:
1028 {
1029 Tk_Cursor newCursor, oldCursor;
1030
1031 if (objIsEmpty) {
1032 newCursor = None;
1033 } else {
1034 newCursor = Tk_AllocCursorFromObj(interp, tkwin, objPtr);
1035 if (newCursor == None) {
1036 return TCL_ERROR;
1037 }
1038 }
1039 oldCursor = *(Tk_Cursor *)ptr;
1040 if (oldCursor != None) {
1041 Tk_FreeCursor(Tk_Display(tkwin), oldCursor);
1042 }
1043 *(Tk_Cursor *)ptr = newCursor;
1044 if (specPtr->type == BLT_CONFIG_ACTIVE_CURSOR) {
1045 Tk_DefineCursor(tkwin, newCursor);
1046 }
1047 }
1048 break;
1049
1050 case BLT_CONFIG_CUSTOM:
1051 {
1052 if ((*(char **)ptr != NULL) &&
1053 (specPtr->customPtr->freeProc != NULL)) {
1054 (*specPtr->customPtr->freeProc)
1055 (specPtr->customPtr->clientData, Tk_Display(tkwin),
1056 widgRec, specPtr->offset);
1057 *(char **)ptr = NULL;
1058 }
1059 if (objIsEmpty) {
1060 *(char **)ptr = NULL;
1061 } else {
1062 int result;
1063
1064 result = (*specPtr->customPtr->parseProc)
1065 (specPtr->customPtr->clientData, interp, tkwin, objPtr,
1066 widgRec, specPtr->offset);
1067 if (result != TCL_OK) {
1068 return TCL_ERROR;
1069 }
1070 }
1071 }
1072 break;
1073
1074 case BLT_CONFIG_DOUBLE:
1075 {
1076 double newDouble;
1077
1078 if (Tcl_GetDoubleFromObj(interp, objPtr, &newDouble)
1079 != TCL_OK) {
1080 return TCL_ERROR;
1081 }
1082 *(double *)ptr = newDouble;
1083 }
1084 break;
1085
1086 case BLT_CONFIG_FONT:
1087 {
1088 Tk_Font newFont, oldFont;
1089
1090 if (objIsEmpty) {
1091 newFont = NULL;
1092 } else {
1093 newFont = Tk_AllocFontFromObj(interp, tkwin, objPtr);
1094 if (newFont == NULL) {
1095 return TCL_ERROR;
1096 }
1097 }
1098 oldFont = *(Tk_Font *)ptr;
1099 if (oldFont != NULL) {
1100 Tk_FreeFont(oldFont);
1101 }
1102 *(Tk_Font *)ptr = newFont;
1103 }
1104 break;
1105
1106 case BLT_CONFIG_INT:
1107 {
1108 int newInt;
1109
1110 if (Tcl_GetIntFromObj(interp, objPtr, &newInt) != TCL_OK) {
1111 return TCL_ERROR;
1112 }
1113 *(int *)ptr = newInt;
1114 }
1115 break;
1116
1117 case BLT_CONFIG_JOIN_STYLE:
1118 {
1119 int join;
1120 Tk_Uid value;
1121
1122 value = Tk_GetUid(Tcl_GetString(objPtr));
1123 if (Tk_GetJoinStyle(interp, value, &join) != TCL_OK) {
1124 return TCL_ERROR;
1125 }
1126 *(int *)ptr = join;
1127 }
1128 break;
1129
1130 case BLT_CONFIG_JUSTIFY:
1131 {
1132 Tk_Justify justify;
1133
1134 if (Tk_GetJustifyFromObj(interp, objPtr, &justify) != TCL_OK) {
1135 return TCL_ERROR;
1136 }
1137 *(Tk_Justify *)ptr = justify;
1138 }
1139 break;
1140
1141 case BLT_CONFIG_MM:
1142 {
1143 double mm;
1144
1145 if (Tk_GetMMFromObj(interp, tkwin, objPtr, &mm) != TCL_OK) {
1146 return TCL_ERROR;
1147 }
1148 *(double *)ptr = mm;
1149 }
1150 break;
1151
1152 case BLT_CONFIG_PIXELS:
1153 {
1154 int pixels;
1155
1156 if (Tk_GetPixelsFromObj(interp, tkwin, objPtr, &pixels)
1157 != TCL_OK) {
1158 return TCL_ERROR;
1159 }
1160 *(int *)ptr = pixels;
1161 }
1162 break;
1163
1164 case BLT_CONFIG_RELIEF:
1165 {
1166 int relief;
1167
1168 if (Tk_GetReliefFromObj(interp, objPtr, &relief) != TCL_OK) {
1169 return TCL_ERROR;
1170 }
1171 *(int *)ptr = relief;
1172 }
1173 break;
1174
1175 case BLT_CONFIG_STRING:
1176 {
1177 char *oldString, *newString;
1178
1179 if (objIsEmpty) {
1180 newString = NULL;
1181 } else {
1182 newString = (char *)Blt_Strdup(Tcl_GetString(objPtr));
1183 }
1184 oldString = *(char **)ptr;
1185 if (oldString != NULL) {
1186 Blt_Free(oldString);
1187 }
1188 *(char **)ptr = newString;
1189 }
1190 break;
1191
1192 case BLT_CONFIG_UID:
1193 if (objIsEmpty) {
1194 *(Tk_Uid *)ptr = NULL;
1195 } else {
1196 *(Tk_Uid *)ptr = Tk_GetUid(Tcl_GetString(objPtr));
1197 }
1198 break;
1199
1200 case BLT_CONFIG_WINDOW:
1201 {
1202 Tk_Window tkwin2;
1203
1204 if (objIsEmpty) {
1205 tkwin2 = None;
1206 } else {
1207 char *path;
1208
1209 path = Tcl_GetString(objPtr);
1210 tkwin2 = Tk_NameToWindow(interp, path, tkwin);
1211 if (tkwin2 == NULL) {
1212 return TCL_ERROR;
1213 }
1214 }
1215 *(Tk_Window *)ptr = tkwin2;
1216 }
1217 break;
1218
1219 case BLT_CONFIG_BITFLAG:
1220 {
1221 int bool;
1222 unsigned int flag;
1223
1224
1225 if (Tcl_GetBooleanFromObj(interp, objPtr, &bool) != TCL_OK) {
1226 return TCL_ERROR;
1227 }
1228 flag = (unsigned int)specPtr->customPtr;
1229 *(int *)ptr &= ~flag;
1230 if (bool) {
1231 *(int *)ptr |= flag;
1232 }
1233 }
1234 break;
1235
1236 case BLT_CONFIG_DASHES:
1237 if (Blt_GetDashesFromObj(interp, objPtr, (Blt_Dashes *)ptr)
1238 != TCL_OK) {
1239 return TCL_ERROR;
1240 }
1241 break;
1242
1243 case BLT_CONFIG_DISTANCE:
1244 {
1245 int newPixels;
1246
1247 if (Blt_GetPixelsFromObj(interp, tkwin, objPtr,
1248 PIXELS_NONNEGATIVE, &newPixels) != TCL_OK) {
1249 return TCL_ERROR;
1250 }
1251 *(int *)ptr = newPixels;
1252 }
1253 break;
1254
1255 case BLT_CONFIG_FILL:
1256 if (Blt_GetFillFromObj(interp, objPtr, (int *)ptr) != TCL_OK) {
1257 return TCL_ERROR;
1258 }
1259 break;
1260
1261 case BLT_CONFIG_FLOAT:
1262 {
1263 double newDouble;
1264
1265 if (Tcl_GetDoubleFromObj(interp, objPtr, &newDouble)
1266 != TCL_OK) {
1267 return TCL_ERROR;
1268 }
1269 *(float *)ptr = (float)newDouble;
1270 }
1271 break;
1272
1273 case BLT_CONFIG_LIST:
1274 {
1275 char **argv;
1276 int argc;
1277
1278 if (Tcl_SplitList(interp, Tcl_GetString(objPtr), &argc, &argv)
1279 != TCL_OK) {
1280 return TCL_ERROR;
1281 }
1282 *(char ***)ptr = argv;
1283 }
1284 break;
1285
1286 case BLT_CONFIG_LISTOBJ:
1287 {
1288 Tcl_Obj **objv;
1289 Tcl_Obj *listObjPtr;
1290 int objc;
1291
1292 if (Tcl_ListObjGetElements(interp, objPtr, &objc, &objv)
1293 != TCL_OK) {
1294 return TCL_ERROR;
1295 }
1296 listObjPtr = Tcl_NewListObj(objc, objv);
1297 Tcl_IncrRefCount(listObjPtr);
1298 *(Tcl_Obj **)ptr = listObjPtr;
1299 }
1300 break;
1301
1302 case BLT_CONFIG_PAD:
1303 if (Blt_GetPadFromObj(interp, tkwin, objPtr, (Blt_Pad *)ptr)
1304 != TCL_OK) {
1305 return TCL_ERROR;
1306 }
1307 break;
1308
1309 case BLT_CONFIG_POS_DISTANCE:
1310 {
1311 int newPixels;
1312
1313 if (Blt_GetPixelsFromObj(interp, tkwin, objPtr,
1314 PIXELS_POSITIVE, &newPixels) != TCL_OK) {
1315 return TCL_ERROR;
1316 }
1317 *(int *)ptr = newPixels;
1318 }
1319 break;
1320
1321 case BLT_CONFIG_SHADOW:
1322 {
1323 Shadow *shadowPtr = (Shadow *)ptr;
1324
1325 if ((shadowPtr != NULL) && (shadowPtr->color != NULL)) {
1326 Tk_FreeColor(shadowPtr->color);
1327 }
1328 if (Blt_GetShadowFromObj(interp, tkwin, objPtr, shadowPtr)
1329 != TCL_OK) {
1330 return TCL_ERROR;
1331 }
1332 }
1333 break;
1334
1335 case BLT_CONFIG_STATE:
1336 {
1337 if (Blt_GetStateFromObj(interp, objPtr, (int *)ptr)
1338 != TCL_OK) {
1339 return TCL_ERROR;
1340 }
1341 }
1342 break;
1343
1344 case BLT_CONFIG_TILE:
1345 {
1346 Blt_Tile newTile, oldTile;
1347
1348 if (objIsEmpty) {
1349 newTile = None;
1350 } else {
1351 if (Blt_GetTile(interp, tkwin, Tcl_GetString(objPtr),
1352 &newTile) != TCL_OK) {
1353 return TCL_ERROR;
1354 }
1355 }
1356 oldTile = *(Blt_Tile *)ptr;
1357 if (oldTile != NULL) {
1358 Blt_FreeTile(oldTile);
1359 }
1360 *(Blt_Tile *)ptr = newTile;
1361 }
1362 break;
1363
1364 case BLT_CONFIG_SIDE:
1365 if (Blt_GetSideFromObj(interp, objPtr, (int *)ptr) != TCL_OK) {
1366 return TCL_ERROR;
1367 }
1368 break;
1369
1370 default:
1371 {
1372 char buf[200];
1373
1374 sprintf(buf, "bad config table: unknown type %d",
1375 specPtr->type);
1376 Tcl_SetResult(interp, buf, TCL_VOLATILE);
1377 return TCL_ERROR;
1378 }
1379 }
1380 specPtr++;
1381 } while ((specPtr->switchName == NULL) &&
1382 (specPtr->type != BLT_CONFIG_END));
1383 return TCL_OK;
1384}
1385
1386/*
1387 *----------------------------------------------------------------------
1388 *
1389 * FormatConfigValue --
1390 *
1391 * This procedure formats the current value of a configuration
1392 * option.
1393 *
1394 * Results:
1395 * The return value is the formatted value of the option given
1396 * by specPtr and widgRec. If the value is static, so that it
1397 * need not be freed, *freeProcPtr will be set to NULL; otherwise
1398 * *freeProcPtr will be set to the address of a procedure to
1399 * free the result, and the caller must invoke this procedure
1400 * when it is finished with the result.
1401 *
1402 * Side effects:
1403 * None.
1404 *
1405 *----------------------------------------------------------------------
1406 */
1407static Tcl_Obj *
1408FormatConfigValue(interp, tkwin, specPtr, widgRec)
1409 Tcl_Interp *interp; /* Interpreter for use in real conversions. */
1410 Tk_Window tkwin; /* Window corresponding to widget. */
1411 Blt_ConfigSpec *specPtr; /* Pointer to information describing option.
1412 * Must not point to a synonym option. */
1413 char *widgRec; /* Pointer to record holding current
1414 * values of info for widget. */
1415{
1416 char *ptr;
1417 char *string;
1418
1419 ptr = widgRec + specPtr->offset;
1420 string = "";
1421 switch (specPtr->type) {
1422 case BLT_CONFIG_ANCHOR:
1423 string = Tk_NameOfAnchor(*(Tk_Anchor *)ptr);
1424 break;
1425
1426 case BLT_CONFIG_BITMAP:
1427 if (*(Pixmap *)ptr != None) {
1428 string = Tk_NameOfBitmap(Tk_Display(tkwin), *(Pixmap *)ptr);
1429 }
1430 break;
1431
1432 case BLT_CONFIG_BOOLEAN:
1433 return Tcl_NewBooleanObj(*(int *)ptr);
1434
1435 case BLT_CONFIG_BORDER:
1436 if (*(Tk_3DBorder *)ptr != NULL) {
1437 string = Tk_NameOf3DBorder(*(Tk_3DBorder *)ptr);
1438 }
1439 break;
1440
1441 case BLT_CONFIG_CAP_STYLE:
1442 string = Tk_NameOfCapStyle(*(int *)ptr);
1443 break;
1444
1445 case BLT_CONFIG_COLOR:
1446 if (*(XColor **)ptr != NULL) {
1447 string = Tk_NameOfColor(*(XColor **)ptr);
1448 }
1449 break;
1450
1451 case BLT_CONFIG_CURSOR:
1452 case BLT_CONFIG_ACTIVE_CURSOR:
1453 if (*(Tk_Cursor *)ptr != None) {
1454 string = Tk_NameOfCursor(Tk_Display(tkwin), *(Tk_Cursor *)ptr);
1455 }
1456 break;
1457
1458 case BLT_CONFIG_CUSTOM:
1459 return (*specPtr->customPtr->printProc)(specPtr->customPtr->clientData,
1460 interp, tkwin, widgRec, specPtr->offset);
1461
1462 case BLT_CONFIG_DOUBLE:
1463 return Tcl_NewDoubleObj(*(double *)ptr);
1464
1465 case BLT_CONFIG_FONT:
1466 if (*(Tk_Font *)ptr != NULL) {
1467 string = Tk_NameOfFont(*(Tk_Font *)ptr);
1468 }
1469 break;
1470
1471 case BLT_CONFIG_INT:
1472 return Tcl_NewIntObj(*(int *)ptr);
1473
1474 case BLT_CONFIG_JOIN_STYLE:
1475 string = Tk_NameOfJoinStyle(*(int *)ptr);
1476 break;
1477
1478 case BLT_CONFIG_JUSTIFY:
1479 string = Tk_NameOfJustify(*(Tk_Justify *)ptr);
1480 break;
1481
1482 case BLT_CONFIG_MM:
1483 return Tcl_NewDoubleObj(*(double *)ptr);
1484
1485 case BLT_CONFIG_PIXELS:
1486 return Tcl_NewIntObj(*(int *)ptr);
1487
1488 case BLT_CONFIG_RELIEF:
1489 string = Tk_NameOfRelief(*(int *)ptr);
1490 break;
1491
1492 case BLT_CONFIG_STRING:
1493 case BLT_CONFIG_UID:
1494 if (*(char **)ptr != NULL) {
1495 string = *(char **)ptr;
1496 }
1497 break;
1498
1499 case BLT_CONFIG_BITFLAG:
1500 {
1501 unsigned int flag;
1502
1503 flag = (*(int *)ptr) & (unsigned int)specPtr->customPtr;
1504 return Tcl_NewBooleanObj((flag != 0));
1505 }
1506
1507 case BLT_CONFIG_DASHES:
1508 {
1509 unsigned char *p;
1510 Tcl_Obj *listObjPtr;
1511 Blt_Dashes *dashesPtr = (Blt_Dashes *)ptr;
1512
1513 listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **)NULL);
1514 for(p = dashesPtr->values; *p != 0; p++) {
1515 Tcl_ListObjAppendElement(interp, listObjPtr, Tcl_NewIntObj(*p));
1516 }
1517 return listObjPtr;
1518 }
1519
1520 case BLT_CONFIG_DISTANCE:
1521 case BLT_CONFIG_POS_DISTANCE:
1522 return Tcl_NewIntObj(*(int *)ptr);
1523
1524 case BLT_CONFIG_FILL:
1525 string = Blt_NameOfFill(*(int *)ptr);
1526 break;
1527
1528 case BLT_CONFIG_FLOAT:
1529 {
1530 double x = *(double *)ptr;
1531 return Tcl_NewDoubleObj(x);
1532 }
1533
1534 case BLT_CONFIG_LIST:
1535 {
1536 Tcl_Obj *objPtr, *listObjPtr;
1537 char **p;
1538
1539 listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **)NULL);
1540 for (p = *(char ***)ptr; *p != NULL; p++) {
1541 objPtr = Tcl_NewStringObj(*p, -1);
1542 Tcl_ListObjAppendElement(interp, listObjPtr, objPtr);
1543 }
1544 return listObjPtr;
1545 }
1546
1547 case BLT_CONFIG_LISTOBJ:
1548 return *(Tcl_Obj **)ptr;
1549
1550 case BLT_CONFIG_PAD:
1551 {
1552 Blt_Pad *padPtr = (Blt_Pad *)ptr;
1553 Tcl_Obj *objPtr, *listObjPtr;
1554
1555 listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **)NULL);
1556 objPtr = Tcl_NewIntObj(padPtr->side1);
1557 Tcl_ListObjAppendElement(interp, listObjPtr, objPtr);
1558 objPtr = Tcl_NewIntObj(padPtr->side2);
1559 Tcl_ListObjAppendElement(interp, listObjPtr, objPtr);
1560 return listObjPtr;
1561 }
1562
1563 case BLT_CONFIG_SHADOW:
1564 {
1565 Shadow *shadowPtr = (Shadow *)ptr;
1566 Tcl_Obj *objPtr, *listObjPtr;
1567
1568 if (shadowPtr->color != NULL) {
1569 listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **)NULL);
1570 objPtr = Tcl_NewStringObj(Tk_NameOfColor(shadowPtr->color), -1);
1571 Tcl_ListObjAppendElement(interp, listObjPtr, objPtr);
1572 objPtr = Tcl_NewIntObj(shadowPtr->offset);
1573 Tcl_ListObjAppendElement(interp, listObjPtr, objPtr);
1574 return listObjPtr;
1575 }
1576 }
1577
1578 case BLT_CONFIG_STATE:
1579 string = Blt_NameOfState(*(int *)ptr);
1580 break;
1581
1582 case BLT_CONFIG_TILE:
1583 string = Blt_NameOfTile((Blt_Tile)ptr);
1584 break;
1585
1586 case BLT_CONFIG_SIDE:
1587 string = Blt_NameOfSide(*(int *)ptr);
1588 break;
1589
1590 default:
1591 string = "?? unknown type ??";
1592 }
1593 return Tcl_NewStringObj(string, -1);
1594}
1595
1596/*
1597 *--------------------------------------------------------------
1598 *
1599 * FormatConfigInfo --
1600 *
1601 * Create a valid Tcl list holding the configuration information
1602 * for a single configuration option.
1603 *
1604 * Results:
1605 * A Tcl list, dynamically allocated. The caller is expected to
1606 * arrange for this list to be freed eventually.
1607 *
1608 * Side effects:
1609 * Memory is allocated.
1610 *
1611 *--------------------------------------------------------------
1612 */
1613static Tcl_Obj *
1614FormatConfigInfo(interp, tkwin, specPtr, widgRec)
1615 Tcl_Interp *interp; /* Interpreter to use for things
1616 * like floating-point precision. */
1617 Tk_Window tkwin; /* Window corresponding to widget. */
1618 register Blt_ConfigSpec *specPtr; /* Pointer to information describing
1619 * option. */
1620 char *widgRec; /* Pointer to record holding current
1621 * values of info for widget. */
1622{
1623 Tcl_Obj *objv[5];
1624 Tcl_Obj *listObjPtr;
1625 register int i;
1626
1627 for (i = 0; i < 5; i++) {
1628 objv[i] = bltEmptyStringObjPtr;
1629 }
1630 if (specPtr->switchName != NULL) {
1631 objv[0] = Tcl_NewStringObj(specPtr->switchName, -1);
1632 }
1633 if (specPtr->dbName != NULL) {
1634 objv[1] = Tcl_NewStringObj(specPtr->dbName, -1);
1635 }
1636 if (specPtr->type == BLT_CONFIG_SYNONYM) {
1637 listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **)NULL);
1638 Tcl_ListObjAppendElement(interp, listObjPtr, objv[0]);
1639 Tcl_ListObjAppendElement(interp, listObjPtr, objv[1]);
1640 return listObjPtr;
1641 }
1642 if (specPtr->dbClass != NULL) {
1643 objv[2] = Tcl_NewStringObj(specPtr->dbClass, -1);
1644 }
1645 if (specPtr->defValue != NULL) {
1646 objv[3] = Tcl_NewStringObj(specPtr->defValue, -1);
1647 }
1648 objv[4] = FormatConfigValue(interp, tkwin, specPtr, widgRec);
1649 return Tcl_NewListObj(5, objv);
1650}
1651
1652/*
1653 *--------------------------------------------------------------
1654 *
1655 * FindConfigSpec --
1656 *
1657 * Search through a table of configuration specs, looking for
1658 * one that matches a given switchName.
1659 *
1660 * Results:
1661 * The return value is a pointer to the matching entry, or NULL
1662 * if nothing matched. In that case an error message is left
1663 * in the interp's result.
1664 *
1665 * Side effects:
1666 * None.
1667 *
1668 *--------------------------------------------------------------
1669 */
1670static Blt_ConfigSpec *
1671FindConfigSpec(interp, specs, objPtr, needFlags, hateFlags)
1672 Tcl_Interp *interp; /* Used for reporting errors. */
1673 Blt_ConfigSpec *specs; /* Pointer to table of configuration
1674 * specifications for a widget. */
1675 Tcl_Obj *objPtr; /* Name (suitable for use in a "config"
1676 * command) identifying particular option. */
1677 int needFlags; /* Flags that must be present in matching
1678 * entry. */
1679 int hateFlags; /* Flags that must NOT be present in
1680 * matching entry. */
1681{
1682 register Blt_ConfigSpec *specPtr;
1683 register char c; /* First character of current argument. */
1684 Blt_ConfigSpec *matchPtr; /* Matching spec, or NULL. */
1685 int length;
1686 char *string;
1687
1688 string = Tcl_GetStringFromObj(objPtr, &length);
1689 c = string[1];
1690 matchPtr = NULL;
1691 for (specPtr = specs; specPtr->type != BLT_CONFIG_END; specPtr++) {
1692 if (specPtr->switchName == NULL) {
1693 continue;
1694 }
1695 if ((specPtr->switchName[1] != c) ||
1696 (strncmp(specPtr->switchName, string, length) != 0)) {
1697 continue;
1698 }
1699 if (((specPtr->specFlags & needFlags) != needFlags) ||
1700 (specPtr->specFlags & hateFlags)) {
1701 continue;
1702 }
1703 if (specPtr->switchName[length] == 0) {
1704 matchPtr = specPtr;
1705 goto gotMatch;
1706 }
1707 if (matchPtr != NULL) {
1708 if (interp != NULL) {
1709 Tcl_AppendResult(interp, "ambiguous option \"", string, "\"",
1710 (char *)NULL);
1711 }
1712 return (Blt_ConfigSpec *)NULL;
1713 }
1714 matchPtr = specPtr;
1715 }
1716
1717 if (matchPtr == NULL) {
1718 if (interp != NULL) {
1719 Tcl_AppendResult(interp, "unknown option \"", string, "\"",
1720 (char *)NULL);
1721 }
1722 return (Blt_ConfigSpec *)NULL;
1723 }
1724
1725 /*
1726 * Found a matching entry. If it's a synonym, then find the
1727 * entry that it's a synonym for.
1728 */
1729
1730 gotMatch:
1731 specPtr = matchPtr;
1732 if (specPtr->type == BLT_CONFIG_SYNONYM) {
1733 for (specPtr = specs; ; specPtr++) {
1734 if (specPtr->type == BLT_CONFIG_END) {
1735 if (interp != NULL) {
1736 Tcl_AppendResult(interp,
1737 "couldn't find synonym for option \"", string,
1738 "\"", (char *) NULL);
1739 }
1740 return (Blt_ConfigSpec *) NULL;
1741 }
1742 if ((specPtr->dbName == matchPtr->dbName) &&
1743 (specPtr->type != BLT_CONFIG_SYNONYM) &&
1744 ((specPtr->specFlags & needFlags) == needFlags) &&
1745 !(specPtr->specFlags & hateFlags)) {
1746 break;
1747 }
1748 }
1749 }
1750 return specPtr;
1751}
1752
1753/* Public routines */
1754
1755/*
1756 *--------------------------------------------------------------
1757 *
1758 * Blt_ConfigureWidgetFromObj --
1759 *
1760 * Process command-line options and database options to
1761 * fill in fields of a widget record with resources and
1762 * other parameters.
1763 *
1764 * Results:
1765 * A standard Tcl return value. In case of an error,
1766 * the interp's result will hold an error message.
1767 *
1768 * Side effects:
1769 * The fields of widgRec get filled in with information
1770 * from argc/argv and the option database. Old information
1771 * in widgRec's fields gets recycled.
1772 *
1773 *--------------------------------------------------------------
1774 */
1775int
1776Blt_ConfigureWidgetFromObj(interp, tkwin, specs, objc, objv, widgRec, flags)
1777 Tcl_Interp *interp; /* Interpreter for error reporting. */
1778 Tk_Window tkwin; /* Window containing widget (needed to
1779 * set up X resources). */
1780 Blt_ConfigSpec *specs; /* Describes legal options. */
1781 int objc; /* Number of elements in argv. */
1782 Tcl_Obj *CONST *objv; /* Command-line options. */
1783 char *widgRec; /* Record whose fields are to be
1784 * modified. Values must be properly
1785 * initialized. */
1786 int flags; /* Used to specify additional flags
1787 * that must be present in config specs
1788 * for them to be considered. Also,
1789 * may have BLT_CONFIG_ARGV_ONLY set. */
1790{
1791 register Blt_ConfigSpec *specPtr;
1792 int needFlags; /* Specs must contain this set of flags
1793 * or else they are not considered. */
1794 int hateFlags; /* If a spec contains any bits here, it's
1795 * not considered. */
1796
1797 if (tkwin == NULL) {
1798 /*
1799 * Either we're not really in Tk, or the main window was destroyed and
1800 * we're on our way out of the application
1801 */
1802 Tcl_AppendResult(interp, "NULL main window", (char *)NULL);
1803 return TCL_ERROR;
1804 }
1805
1806 needFlags = flags & ~(BLT_CONFIG_USER_BIT - 1);
1807 if (Tk_Depth(tkwin) <= 1) {
1808 hateFlags = BLT_CONFIG_COLOR_ONLY;
1809 } else {
1810 hateFlags = BLT_CONFIG_MONO_ONLY;
1811 }
1812
1813 /*
1814 * Pass one: scan through all the option specs, replacing strings
1815 * with Tk_Uid structs (if this hasn't been done already) and
1816 * clearing the BLT_CONFIG_OPTION_SPECIFIED flags.
1817 */
1818
1819 for (specPtr = specs; specPtr->type != BLT_CONFIG_END; specPtr++) {
1820 if (!(specPtr->specFlags & INIT) && (specPtr->switchName != NULL)) {
1821 if (specPtr->dbName != NULL) {
1822 specPtr->dbName = Tk_GetUid(specPtr->dbName);
1823 }
1824 if (specPtr->dbClass != NULL) {
1825 specPtr->dbClass = Tk_GetUid(specPtr->dbClass);
1826 }
1827 if (specPtr->defValue != NULL) {
1828 specPtr->defValue = Tk_GetUid(specPtr->defValue);
1829 }
1830 }
1831 specPtr->specFlags =
1832 (specPtr->specFlags & ~BLT_CONFIG_OPTION_SPECIFIED) | INIT;
1833 }
1834
1835 /*
1836 * Pass two: scan through all of the arguments, processing those
1837 * that match entries in the specs.
1838 */
1839 while (objc > 0) {
1840 specPtr = FindConfigSpec(interp, specs, objv[0], needFlags, hateFlags);
1841 if (specPtr == NULL) {
1842 return TCL_ERROR;
1843 }
1844
1845 /* Process the entry. */
1846 if (objc < 2) {
1847 Tcl_AppendResult(interp, "value for \"", Tcl_GetString(objv[0]),
1848 "\" missing", (char *) NULL);
1849 return TCL_ERROR;
1850 }
1851 if (DoConfig(interp, tkwin, specPtr, objv[1], widgRec) != TCL_OK) {
1852 char msg[100];
1853
1854 sprintf(msg, "\n (processing \"%.40s\" option)",
1855 specPtr->switchName);
1856 Tcl_AddErrorInfo(interp, msg);
1857 return TCL_ERROR;
1858 }
1859 specPtr->specFlags |= BLT_CONFIG_OPTION_SPECIFIED;
1860 objc -= 2, objv += 2;
1861 }
1862
1863 /*
1864 * Pass three: scan through all of the specs again; if no
1865 * command-line argument matched a spec, then check for info
1866 * in the option database. If there was nothing in the
1867 * database, then use the default.
1868 */
1869
1870 if (!(flags & BLT_CONFIG_OBJV_ONLY)) {
1871 Tcl_Obj *objPtr;
1872
1873 for (specPtr = specs; specPtr->type != BLT_CONFIG_END; specPtr++) {
1874 if ((specPtr->specFlags & BLT_CONFIG_OPTION_SPECIFIED) ||
1875 (specPtr->switchName == NULL) ||
1876 (specPtr->type == BLT_CONFIG_SYNONYM)) {
1877 continue;
1878 }
1879 if (((specPtr->specFlags & needFlags) != needFlags) ||
1880 (specPtr->specFlags & hateFlags)) {
1881 continue;
1882 }
1883 objPtr = NULL;
1884 if (specPtr->dbName != NULL) {
1885 Tk_Uid value;
1886
1887 value = Tk_GetOption(tkwin, specPtr->dbName, specPtr->dbClass);
1888 if (value != NULL) {
1889 objPtr = Tcl_NewStringObj(value, -1);
1890 }
1891 }
1892 if (objPtr != NULL) {
1893 if (DoConfig(interp, tkwin, specPtr, objPtr, widgRec)
1894 != TCL_OK) {
1895 char msg[200];
1896
1897 sprintf(msg, "\n (%s \"%.50s\" in widget \"%.50s\")",
1898 "database entry for",
1899 specPtr->dbName, Tk_PathName(tkwin));
1900 Tcl_AddErrorInfo(interp, msg);
1901 return TCL_ERROR;
1902 }
1903 } else {
1904 if (specPtr->defValue != NULL) {
1905 objPtr = Tcl_NewStringObj(specPtr->defValue, -1);
1906 } else {
1907 objPtr = NULL;
1908 }
1909 if ((objPtr != NULL) && !(specPtr->specFlags
1910 & BLT_CONFIG_DONT_SET_DEFAULT)) {
1911 if (DoConfig(interp, tkwin, specPtr, objPtr, widgRec)
1912 != TCL_OK) {
1913 char msg[200];
1914
1915 sprintf(msg,
1916 "\n (%s \"%.50s\" in widget \"%.50s\")",
1917 "default value for",
1918 specPtr->dbName, Tk_PathName(tkwin));
1919 Tcl_AddErrorInfo(interp, msg);
1920 return TCL_ERROR;
1921 }
1922 }
1923 }
1924 }
1925 }
1926
1927 return TCL_OK;
1928}
1929
1930/*
1931 *--------------------------------------------------------------
1932 *
1933 * Blt_ConfigureInfoFromObj --
1934 *
1935 * Return information about the configuration options
1936 * for a window, and their current values.
1937 *
1938 * Results:
1939 * Always returns TCL_OK. The interp's result will be modified
1940 * hold a description of either a single configuration option
1941 * available for "widgRec" via "specs", or all the configuration
1942 * options available. In the "all" case, the result will
1943 * available for "widgRec" via "specs". The result will
1944 * be a list, each of whose entries describes one option.
1945 * Each entry will itself be a list containing the option's
1946 * name for use on command lines, database name, database
1947 * class, default value, and current value (empty string
1948 * if none). For options that are synonyms, the list will
1949 * contain only two values: name and synonym name. If the
1950 * "name" argument is non-NULL, then the only information
1951 * returned is that for the named argument (i.e. the corresponding
1952 * entry in the overall list is returned).
1953 *
1954 * Side effects:
1955 * None.
1956 *
1957 *--------------------------------------------------------------
1958 */
1959
1960int
1961Blt_ConfigureInfoFromObj(interp, tkwin, specs, widgRec, objPtr, flags)
1962 Tcl_Interp *interp; /* Interpreter for error reporting. */
1963 Tk_Window tkwin; /* Window corresponding to widgRec. */
1964 Blt_ConfigSpec *specs; /* Describes legal options. */
1965 char *widgRec; /* Record whose fields contain current
1966 * values for options. */
1967 Tcl_Obj *objPtr; /* If non-NULL, indicates a single option
1968 * whose info is to be returned. Otherwise
1969 * info is returned for all options. */
1970 int flags; /* Used to specify additional flags
1971 * that must be present in config specs
1972 * for them to be considered. */
1973{
1974 register Blt_ConfigSpec *specPtr;
1975 int needFlags, hateFlags;
1976 char *string;
1977 Tcl_Obj *listObjPtr, *valueObjPtr;
1978
1979 needFlags = flags & ~(BLT_CONFIG_USER_BIT - 1);
1980 if (Tk_Depth(tkwin) <= 1) {
1981 hateFlags = BLT_CONFIG_COLOR_ONLY;
1982 } else {
1983 hateFlags = BLT_CONFIG_MONO_ONLY;
1984 }
1985
1986 /*
1987 * If information is only wanted for a single configuration
1988 * spec, then handle that one spec specially.
1989 */
1990
1991 Tcl_SetResult(interp, (char *)NULL, TCL_STATIC);
1992 if (objPtr != NULL) {
1993 specPtr = FindConfigSpec(interp, specs, objPtr, needFlags, hateFlags);
1994 if (specPtr == NULL) {
1995 return TCL_ERROR;
1996 }
1997 valueObjPtr = FormatConfigInfo(interp, tkwin, specPtr, widgRec);
1998 Tcl_SetObjResult(interp, valueObjPtr);
1999 return TCL_OK;
2000 }
2001
2002 /*
2003 * Loop through all the specs, creating a big list with all
2004 * their information.
2005 */
2006 string = NULL; /* Suppress compiler warning. */
2007 if (objPtr != NULL) {
2008 string = Tcl_GetString(objPtr);
2009 }
2010 listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **)NULL);
2011 for (specPtr = specs; specPtr->type != BLT_CONFIG_END; specPtr++) {
2012 if ((objPtr != NULL) && (specPtr->switchName != string)) {
2013 continue;
2014 }
2015 if (((specPtr->specFlags & needFlags) != needFlags) ||
2016 (specPtr->specFlags & hateFlags)) {
2017 continue;
2018 }
2019 if (specPtr->switchName == NULL) {
2020 continue;
2021 }
2022 valueObjPtr = FormatConfigInfo(interp, tkwin, specPtr, widgRec);
2023 Tcl_ListObjAppendElement(interp, listObjPtr, valueObjPtr);
2024 }
2025 Tcl_SetObjResult(interp, listObjPtr);
2026 return TCL_OK;
2027}
2028
2029/*
2030 *----------------------------------------------------------------------
2031 *
2032 * Blt_ConfigureValueFromObj --
2033 *
2034 * This procedure returns the current value of a configuration
2035 * option for a widget.
2036 *
2037 * Results:
2038 * The return value is a standard Tcl completion code (TCL_OK or
2039 * TCL_ERROR). The interp's result will be set to hold either the value
2040 * of the option given by objPtr (if TCL_OK is returned) or
2041 * an error message (if TCL_ERROR is returned).
2042 *
2043 * Side effects:
2044 * None.
2045 *
2046 *----------------------------------------------------------------------
2047 */
2048int
2049Blt_ConfigureValueFromObj(interp, tkwin, specs, widgRec, objPtr, flags)
2050 Tcl_Interp *interp; /* Interpreter for error reporting. */
2051 Tk_Window tkwin; /* Window corresponding to widgRec. */
2052 Blt_ConfigSpec *specs; /* Describes legal options. */
2053 char *widgRec; /* Record whose fields contain current
2054 * values for options. */
2055 Tcl_Obj *objPtr; /* Gives the command-line name for the
2056 * option whose value is to be returned. */
2057 int flags; /* Used to specify additional flags
2058 * that must be present in config specs
2059 * for them to be considered. */
2060{
2061 Blt_ConfigSpec *specPtr;
2062 int needFlags, hateFlags;
2063
2064 needFlags = flags & ~(BLT_CONFIG_USER_BIT - 1);
2065 if (Tk_Depth(tkwin) <= 1) {
2066 hateFlags = BLT_CONFIG_COLOR_ONLY;
2067 } else {
2068 hateFlags = BLT_CONFIG_MONO_ONLY;
2069 }
2070 specPtr = FindConfigSpec(interp, specs, objPtr, needFlags, hateFlags);
2071 if (specPtr == NULL) {
2072 return TCL_ERROR;
2073 }
2074 objPtr = FormatConfigValue(interp, tkwin, specPtr, widgRec);
2075 Tcl_SetObjResult(interp, objPtr);
2076 return TCL_OK;
2077}
2078
2079/*
2080 *----------------------------------------------------------------------
2081 *
2082 * Blt_FreeObjOptions --
2083 *
2084 * Free up all resources associated with configuration options.
2085 *
2086 * Results:
2087 * None.
2088 *
2089 * Side effects:
2090 * Any resource in widgRec that is controlled by a configuration
2091 * option (e.g. a Tk_3DBorder or XColor) is freed in the appropriate
2092 * fashion.
2093 *
2094 *----------------------------------------------------------------------
2095 */
2096void
2097Blt_FreeObjOptions(specs, widgRec, display, needFlags)
2098 Blt_ConfigSpec *specs; /* Describes legal options. */
2099 char *widgRec; /* Record whose fields contain current
2100 * values for options. */
2101 Display *display; /* X display; needed for freeing some
2102 * resources. */
2103 int needFlags; /* Used to specify additional flags
2104 * that must be present in config specs
2105 * for them to be considered. */
2106{
2107 register Blt_ConfigSpec *specPtr;
2108 char *ptr;
2109
2110 for (specPtr = specs; specPtr->type != BLT_CONFIG_END; specPtr++) {
2111 if ((specPtr->specFlags & needFlags) != needFlags) {
2112 continue;
2113 }
2114 ptr = widgRec + specPtr->offset;
2115 switch (specPtr->type) {
2116 case BLT_CONFIG_STRING:
2117 if (*((char **) ptr) != NULL) {
2118 Blt_Free(*((char **) ptr));
2119 *((char **) ptr) = NULL;
2120 }
2121 break;
2122
2123 case BLT_CONFIG_COLOR:
2124 if (*((XColor **) ptr) != NULL) {
2125 Tk_FreeColor(*((XColor **) ptr));
2126 *((XColor **) ptr) = NULL;
2127 }
2128 break;
2129
2130 case BLT_CONFIG_FONT:
2131 Tk_FreeFont(*((Tk_Font *) ptr));
2132 *((Tk_Font *) ptr) = NULL;
2133 break;
2134
2135 case BLT_CONFIG_BITMAP:
2136 if (*((Pixmap *) ptr) != None) {
2137 Tk_FreeBitmap(display, *((Pixmap *) ptr));
2138 *((Pixmap *) ptr) = None;
2139 }
2140 break;
2141
2142 case BLT_CONFIG_BORDER:
2143 if (*((Tk_3DBorder *) ptr) != NULL) {
2144 Tk_Free3DBorder(*((Tk_3DBorder *) ptr));
2145 *((Tk_3DBorder *) ptr) = NULL;
2146 }
2147 break;
2148
2149 case BLT_CONFIG_CURSOR:
2150 case BLT_CONFIG_ACTIVE_CURSOR:
2151 if (*((Tk_Cursor *) ptr) != None) {
2152 Tk_FreeCursor(display, *((Tk_Cursor *) ptr));
2153 *((Tk_Cursor *) ptr) = None;
2154 }
2155 break;
2156
2157 case BLT_CONFIG_LISTOBJ:
2158 Tcl_DecrRefCount(*(Tcl_Obj **)ptr);
2159 break;
2160
2161 case BLT_CONFIG_LIST:
2162 {
2163 char **argv;
2164
2165 argv = *(char ***)ptr;
2166 if (argv != NULL) {
2167 Blt_Free(argv);
2168 *(char ***)ptr = NULL;
2169 }
2170 }
2171 break;
2172
2173 case BLT_CONFIG_TILE:
2174 if ((Blt_Tile)ptr != NULL) {
2175 Blt_FreeTile((Blt_Tile)ptr);
2176 *(Blt_Tile *)ptr = NULL;
2177 }
2178 break;
2179
2180 case BLT_CONFIG_CUSTOM:
2181 if ((*(char **)ptr != NULL) &&
2182 (specPtr->customPtr->freeProc != NULL)) {
2183 (*specPtr->customPtr->freeProc)(specPtr->customPtr->clientData,
2184 display, widgRec, specPtr->offset);
2185 *(char **)ptr = NULL;
2186 }
2187 break;
2188 }
2189 }
2190}
2191
2192/*
2193 *----------------------------------------------------------------------
2194 *
2195 * Blt_ObjConfigModified --
2196 *
2197 * Given the configuration specifications and one or more option
2198 * patterns (terminated by a NULL), indicate if any of the matching
2199 * configuration options has been reset.
2200 *
2201 * Results:
2202 * Returns 1 if one of the options has changed, 0 otherwise.
2203 *
2204 *----------------------------------------------------------------------
2205 */
2206int
2207Blt_ObjConfigModified TCL_VARARGS_DEF(Blt_ConfigSpec *, arg1)
2208{
2209 va_list argList;
2210 Blt_ConfigSpec *specs;
2211 register Blt_ConfigSpec *specPtr;
2212 register char *option;
2213
2214 specs = TCL_VARARGS_START(Blt_ConfigSpec *, arg1, argList);
2215 while ((option = va_arg(argList, char *)) != NULL) {
2216 for (specPtr = specs; specPtr->type != BLT_CONFIG_END; specPtr++) {
2217 if ((Tcl_StringMatch(specPtr->switchName, option)) &&
2218 (specPtr->specFlags & BLT_CONFIG_OPTION_SPECIFIED)) {
2219 va_end(argList);
2220 return 1;
2221 }
2222 }
2223 }
2224 va_end(argList);
2225 return 0;
2226}
2227
2228/*
2229 *----------------------------------------------------------------------
2230 *
2231 * Blt_ConfigureComponentFromObj --
2232 *
2233 * Configures a component of a widget. This is useful for
2234 * widgets that have multiple components which aren't uniquely
2235 * identified by a Tk_Window. It allows us, for example, set
2236 * resources for axes of the graph widget. The graph really has
2237 * only one window, but its convenient to specify components in a
2238 * hierarchy of options.
2239 *
2240 * *graph.x.logScale yes
2241 * *graph.Axis.logScale yes
2242 * *graph.temperature.scaleSymbols yes
2243 * *graph.Element.scaleSymbols yes
2244 *
2245 * This is really a hack to work around the limitations of the Tk
2246 * resource database. It creates a temporary window, needed to
2247 * call Tk_ConfigureWidget, using the name of the component.
2248 *
2249 * Results:
2250 * A standard Tcl result.
2251 *
2252 * Side Effects:
2253 * A temporary window is created merely to pass to Tk_ConfigureWidget.
2254 *
2255 *----------------------------------------------------------------------
2256 */
2257int
2258Blt_ConfigureComponentFromObj(interp, parent, name, className, specsPtr,
2259 objc, objv, widgRec, flags)
2260 Tcl_Interp *interp;
2261 Tk_Window parent; /* Window to associate with component */
2262 char *name; /* Name of component */
2263 char *className;
2264 Blt_ConfigSpec *specsPtr;
2265 int objc;
2266 Tcl_Obj *CONST *objv;
2267 char *widgRec;
2268 int flags;
2269{
2270 Tk_Window tkwin;
2271 int result;
2272 char *tmpName;
2273 int isTemporary = FALSE;
2274
2275 tmpName = Blt_Strdup(name);
2276
2277 /* Window name can't start with an upper case letter */
2278 tmpName[0] = tolower(name[0]);
2279
2280 /*
2281 * Create component if a child window by the component's name
2282 * doesn't already exist.
2283 */
2284 tkwin = Blt_FindChild(parent, tmpName);
2285 if (tkwin == NULL) {
2286 tkwin = Tk_CreateWindow(interp, parent, tmpName, (char *)NULL);
2287 isTemporary = TRUE;
2288 }
2289 if (tkwin == NULL) {
2290 Tcl_AppendResult(interp, "can't find window in \"",
2291 Tk_PathName(parent), "\"", (char *)NULL);
2292 return TCL_ERROR;
2293 }
2294 assert(Tk_Depth(tkwin) == Tk_Depth(parent));
2295 Blt_Free(tmpName);
2296
2297 Tk_SetClass(tkwin, className);
2298 result = Blt_ConfigureWidgetFromObj(interp, tkwin, specsPtr, objc, objv,
2299 widgRec, flags);
2300 if (isTemporary) {
2301 Tk_DestroyWindow(tkwin);
2302 }
2303 return result;
2304}
2305
2306/*
2307 *--------------------------------------------------------------
2308 *
2309 * Blt_ObjIsOption --
2310 *
2311 * Indicates whether objPtr is a valid configuration option
2312 * such as -background.
2313 *
2314 * Results:
2315 * Returns 1 is a matching option is found and 0 otherwise.
2316 *
2317 *--------------------------------------------------------------
2318 */
2319int
2320Blt_ObjIsOption(specs, objPtr, flags)
2321 Blt_ConfigSpec *specs; /* Describes legal options. */
2322 Tcl_Obj *objPtr; /* Command-line option name. */
2323 int flags; /* Used to specify additional flags
2324 * that must be present in config specs
2325 * for them to be considered. Also,
2326 * may have BLT_CONFIG_ARGV_ONLY set. */
2327{
2328 register Blt_ConfigSpec *specPtr;
2329 int needFlags; /* Specs must contain this set of flags
2330 * or else they are not considered. */
2331
2332 needFlags = flags & ~(BLT_CONFIG_USER_BIT - 1);
2333 specPtr = FindConfigSpec((Tcl_Interp *)NULL, specs, objPtr, needFlags, 0);
2334 return (specPtr != NULL);
2335}
2336
2337
2338#endif /* TK_VERSION_NUMBER >= 8.1.0 */
Note: See TracBrowser for help on using the repository browser.