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