1/*
2 * tkObj.c --
3 *
4 *	This file contains procedures that implement the common Tk object
5 *	types
6 *
7 * Copyright (c) 1997 Sun Microsystems, Inc.
8 *
9 * See the file "license.terms" for information on usage and redistribution
10 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
11 *
12 * RCS: @(#) $Id: tkObj.c,v 1.8.2.2 2005/01/11 16:05:16 dkf Exp $
13 */
14
15#include "tkInt.h"
16
17/*
18 * The following structure is the internal representation for pixel objects.
19 */
20
21typedef struct PixelRep {
22    double value;
23    int units;
24    Tk_Window tkwin;
25    int returnValue;
26} PixelRep;
27
28#define SIMPLE_PIXELREP(objPtr)				\
29    ((objPtr)->internalRep.twoPtrValue.ptr2 == 0)
30
31#define SET_SIMPLEPIXEL(objPtr, intval)			\
32    (objPtr)->internalRep.twoPtrValue.ptr1 = (VOID *) (intval);	\
33    (objPtr)->internalRep.twoPtrValue.ptr2 = 0
34
35#define GET_SIMPLEPIXEL(objPtr)				\
36    ((int) (objPtr)->internalRep.twoPtrValue.ptr1)
37
38#define SET_COMPLEXPIXEL(objPtr, repPtr)		\
39    (objPtr)->internalRep.twoPtrValue.ptr1 = 0;		\
40    (objPtr)->internalRep.twoPtrValue.ptr2 = (VOID *) repPtr
41
42#define GET_COMPLEXPIXEL(objPtr)			\
43    ((PixelRep *) (objPtr)->internalRep.twoPtrValue.ptr2)
44
45
46/*
47 * The following structure is the internal representation for mm objects.
48 */
49
50typedef struct MMRep {
51    double value;
52    int units;
53    Tk_Window tkwin;
54    double returnValue;
55} MMRep;
56
57/*
58 * The following structure is the internal representation for window objects.
59 * A WindowRep caches name-to-window lookups.  The cache is invalid
60 * if tkwin is NULL or if mainPtr->deletionEpoch does not match epoch.
61 */
62typedef struct WindowRep {
63    Tk_Window tkwin;		/* Cached window; NULL if not found */
64    TkMainInfo *mainPtr;	/* MainWindow associated with tkwin */
65    long epoch;			/* Value of mainPtr->deletionEpoch at last
66				 * successful lookup.  */
67} WindowRep;
68
69/*
70 * Prototypes for procedures defined later in this file:
71 */
72
73static void		DupMMInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
74			    Tcl_Obj *copyPtr));
75static void		DupPixelInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
76			    Tcl_Obj *copyPtr));
77static void		DupWindowInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
78			    Tcl_Obj *copyPtr));
79static void		FreeMMInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr));
80static void		FreePixelInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr));
81static void		FreeWindowInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr));
82static void		UpdateStringOfMM _ANSI_ARGS_((Tcl_Obj *objPtr));
83static int		SetMMFromAny _ANSI_ARGS_((Tcl_Interp *interp,
84			    Tcl_Obj *objPtr));
85static int		SetPixelFromAny _ANSI_ARGS_((Tcl_Interp *interp,
86			    Tcl_Obj *objPtr));
87static int		SetWindowFromAny _ANSI_ARGS_((Tcl_Interp *interp,
88			    Tcl_Obj *objPtr));
89
90/*
91 * The following structure defines the implementation of the "pixel"
92 * Tcl object, used for measuring distances.  The pixel object remembers
93 * its initial display-independant settings.
94 */
95
96static Tcl_ObjType pixelObjType = {
97    "pixel",			/* name */
98    FreePixelInternalRep,	/* freeIntRepProc */
99    DupPixelInternalRep,	/* dupIntRepProc */
100    NULL,			/* updateStringProc */
101    SetPixelFromAny		/* setFromAnyProc */
102};
103
104/*
105 * The following structure defines the implementation of the "pixel"
106 * Tcl object, used for measuring distances.  The pixel object remembers
107 * its initial display-independant settings.
108 */
109
110static Tcl_ObjType mmObjType = {
111    "mm",			/* name */
112    FreeMMInternalRep,		/* freeIntRepProc */
113    DupMMInternalRep,		/* dupIntRepProc */
114    UpdateStringOfMM,		/* updateStringProc */
115    SetMMFromAny		/* setFromAnyProc */
116};
117
118/*
119 * The following structure defines the implementation of the "window"
120 * Tcl object.
121 */
122
123static Tcl_ObjType windowObjType = {
124    "window",				/* name */
125    FreeWindowInternalRep,		/* freeIntRepProc */
126    DupWindowInternalRep,		/* dupIntRepProc */
127    NULL,				/* updateStringProc */
128    SetWindowFromAny			/* setFromAnyProc */
129};
130
131
132
133/*
134 *----------------------------------------------------------------------
135 *
136 * Tk_GetPixelsFromObj --
137 *
138 *	Attempt to return a pixel value from the Tcl object "objPtr". If the
139 *	object is not already a pixel value, an attempt will be made to convert
140 *	it to one.
141 *
142 * Results:
143 *	The return value is a standard Tcl object result. If an error occurs
144 *	during conversion, an error message is left in the interpreter's
145 *	result unless "interp" is NULL.
146 *
147 * Side effects:
148 *	If the object is not already a pixel, the conversion will free
149 *	any old internal representation.
150 *
151 *----------------------------------------------------------------------
152 */
153
154int
155Tk_GetPixelsFromObj(interp, tkwin, objPtr, intPtr)
156    Tcl_Interp *interp; 	/* Used for error reporting if not NULL. */
157    Tk_Window tkwin;
158    Tcl_Obj *objPtr;		/* The object from which to get pixels. */
159    int *intPtr;		/* Place to store resulting pixels. */
160{
161    int result;
162    double d;
163    PixelRep *pixelPtr;
164    static double bias[] = {
165	1.0,	10.0,	25.4,	25.4 / 72.0
166    };
167
168    if (objPtr->typePtr != &pixelObjType) {
169	result = SetPixelFromAny(interp, objPtr);
170	if (result != TCL_OK) {
171	    return result;
172	}
173    }
174
175    if (SIMPLE_PIXELREP(objPtr)) {
176	*intPtr = GET_SIMPLEPIXEL(objPtr);
177    } else {
178	pixelPtr = GET_COMPLEXPIXEL(objPtr);
179	if (pixelPtr->tkwin != tkwin) {
180	    d = pixelPtr->value;
181	    if (pixelPtr->units >= 0) {
182		d *= bias[pixelPtr->units] * WidthOfScreen(Tk_Screen(tkwin));
183		d /= WidthMMOfScreen(Tk_Screen(tkwin));
184	    }
185	    if (d < 0) {
186		pixelPtr->returnValue = (int) (d - 0.5);
187	    } else {
188		pixelPtr->returnValue = (int) (d + 0.5);
189	    }
190	    pixelPtr->tkwin = tkwin;
191	}
192        *intPtr = pixelPtr->returnValue;
193    }
194    return TCL_OK;
195}
196
197/*
198 *----------------------------------------------------------------------
199 *
200 * FreePixelInternalRep --
201 *
202 *	Deallocate the storage associated with a pixel object's internal
203 *	representation.
204 *
205 * Results:
206 *	None.
207 *
208 * Side effects:
209 *	Frees objPtr's internal representation and sets objPtr's
210 *	internalRep to NULL.
211 *
212 *----------------------------------------------------------------------
213 */
214
215static void
216FreePixelInternalRep(objPtr)
217    Tcl_Obj *objPtr;		/* Pixel object with internal rep to free. */
218{
219    PixelRep *pixelPtr;
220
221    if (!SIMPLE_PIXELREP(objPtr)) {
222	pixelPtr = GET_COMPLEXPIXEL(objPtr);
223	ckfree((char *) pixelPtr);
224    }
225    SET_SIMPLEPIXEL(objPtr, 0);
226    objPtr->typePtr = NULL;
227}
228
229/*
230 *----------------------------------------------------------------------
231 *
232 * DupPixelInternalRep --
233 *
234 *	Initialize the internal representation of a pixel Tcl_Obj to a
235 *	copy of the internal representation of an existing pixel object.
236 *
237 * Results:
238 *	None.
239 *
240 * Side effects:
241 *	copyPtr's internal rep is set to the pixel corresponding to
242 *	srcPtr's internal rep.
243 *
244 *----------------------------------------------------------------------
245 */
246
247static void
248DupPixelInternalRep(srcPtr, copyPtr)
249    register Tcl_Obj *srcPtr;	/* Object with internal rep to copy. */
250    register Tcl_Obj *copyPtr;	/* Object with internal rep to set. */
251{
252    PixelRep *oldPtr, *newPtr;
253
254    copyPtr->typePtr = srcPtr->typePtr;
255
256    if (SIMPLE_PIXELREP(srcPtr)) {
257	SET_SIMPLEPIXEL(copyPtr, GET_SIMPLEPIXEL(srcPtr));
258    } else {
259	oldPtr = GET_COMPLEXPIXEL(srcPtr);
260	newPtr = (PixelRep *) ckalloc(sizeof(PixelRep));
261	newPtr->value = oldPtr->value;
262	newPtr->units = oldPtr->units;
263	newPtr->tkwin = oldPtr->tkwin;
264	newPtr->returnValue = oldPtr->returnValue;
265	SET_COMPLEXPIXEL(copyPtr, newPtr);
266    }
267}
268
269/*
270 *----------------------------------------------------------------------
271 *
272 * SetPixelFromAny --
273 *
274 *	Attempt to generate a pixel internal form for the Tcl object
275 *	"objPtr".
276 *
277 * Results:
278 *	The return value is a standard Tcl result. If an error occurs during
279 *	conversion, an error message is left in the interpreter's result
280 *	unless "interp" is NULL.
281 *
282 * Side effects:
283 *	If no error occurs, a pixel representation of the object is
284 *	stored internally and the type of "objPtr" is set to pixel.
285 *
286 *----------------------------------------------------------------------
287 */
288
289static int
290SetPixelFromAny(interp, objPtr)
291    Tcl_Interp *interp;		/* Used for error reporting if not NULL. */
292    Tcl_Obj *objPtr;		/* The object to convert. */
293{
294    Tcl_ObjType *typePtr;
295    char *string, *rest;
296    double d;
297    int i, units;
298    PixelRep *pixelPtr;
299
300    string = Tcl_GetStringFromObj(objPtr, NULL);
301
302    d = strtod(string, &rest);
303    if (rest == string) {
304	/*
305	 * Must copy string before resetting the result in case a caller
306	 * is trying to convert the interpreter's result to pixels.
307	 */
308
309	char buf[100];
310
311	error:
312	sprintf(buf, "bad screen distance \"%.50s\"", string);
313	Tcl_ResetResult(interp);
314	Tcl_AppendResult(interp, buf, NULL);
315	return TCL_ERROR;
316    }
317    while ((*rest != '\0') && isspace(UCHAR(*rest))) {
318	rest++;
319    }
320    switch (*rest) {
321	case '\0':
322	    units = -1;
323	    break;
324
325	case 'm':
326	    units = 0;
327	    break;
328
329	case 'c':
330	    units = 1;
331	    break;
332
333	case 'i':
334	    units = 2;
335	    break;
336
337	case 'p':
338	    units = 3;
339	    break;
340
341	default:
342	    goto error;
343    }
344
345    /*
346     * Free the old internalRep before setting the new one.
347     */
348
349    typePtr = objPtr->typePtr;
350    if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
351	(*typePtr->freeIntRepProc)(objPtr);
352    }
353
354    objPtr->typePtr = &pixelObjType;
355
356    i = (int) d;
357    if ((units < 0) && (i == d)) {
358	SET_SIMPLEPIXEL(objPtr, i);
359    } else {
360	pixelPtr = (PixelRep *) ckalloc(sizeof(PixelRep));
361	pixelPtr->value = d;
362	pixelPtr->units = units;
363	pixelPtr->tkwin = NULL;
364	pixelPtr->returnValue = i;
365	SET_COMPLEXPIXEL(objPtr, pixelPtr);
366    }
367    return TCL_OK;
368}
369
370/*
371 *----------------------------------------------------------------------
372 *
373 * Tk_GetMMFromObj --
374 *
375 *	Attempt to return an mm value from the Tcl object "objPtr". If the
376 *	object is not already an mm value, an attempt will be made to convert
377 *	it to one.
378 *
379 * Results:
380 *	The return value is a standard Tcl object result. If an error occurs
381 *	during conversion, an error message is left in the interpreter's
382 *	result unless "interp" is NULL.
383 *
384 * Side effects:
385 *	If the object is not already a pixel, the conversion will free
386 *	any old internal representation.
387 *
388 *----------------------------------------------------------------------
389 */
390
391int
392Tk_GetMMFromObj(interp, tkwin, objPtr, doublePtr)
393    Tcl_Interp *interp; 	/* Used for error reporting if not NULL. */
394    Tk_Window tkwin;
395    Tcl_Obj *objPtr;		/* The object from which to get mms. */
396    double *doublePtr;		/* Place to store resulting millimeters. */
397{
398    int result;
399    double d;
400    MMRep *mmPtr;
401    static double bias[] = {
402	10.0,	25.4,	1.0,	25.4 / 72.0
403    };
404
405    if (objPtr->typePtr != &mmObjType) {
406	result = SetMMFromAny(interp, objPtr);
407	if (result != TCL_OK) {
408	    return result;
409	}
410    }
411
412    mmPtr = (MMRep *) objPtr->internalRep.otherValuePtr;
413    if (mmPtr->tkwin != tkwin) {
414	d = mmPtr->value;
415	if (mmPtr->units == -1) {
416	    d /= WidthOfScreen(Tk_Screen(tkwin));
417	    d *= WidthMMOfScreen(Tk_Screen(tkwin));
418	} else {
419	    d *= bias[mmPtr->units];
420	}
421	mmPtr->tkwin = tkwin;
422	mmPtr->returnValue = d;
423    }
424    *doublePtr = mmPtr->returnValue;
425
426    return TCL_OK;
427}
428
429/*
430 *----------------------------------------------------------------------
431 *
432 * FreeMMInternalRep --
433 *
434 *	Deallocate the storage associated with a mm object's internal
435 *	representation.
436 *
437 * Results:
438 *	None.
439 *
440 * Side effects:
441 *	Frees objPtr's internal representation and sets objPtr's
442 *	internalRep to NULL.
443 *
444 *----------------------------------------------------------------------
445 */
446
447static void
448FreeMMInternalRep(objPtr)
449    Tcl_Obj *objPtr;		/* MM object with internal rep to free. */
450{
451    ckfree((char *) objPtr->internalRep.otherValuePtr);
452    objPtr->internalRep.otherValuePtr = NULL;
453    objPtr->typePtr = NULL;
454}
455
456/*
457 *----------------------------------------------------------------------
458 *
459 * DupMMInternalRep --
460 *
461 *	Initialize the internal representation of a pixel Tcl_Obj to a
462 *	copy of the internal representation of an existing pixel object.
463 *
464 * Results:
465 *	None.
466 *
467 * Side effects:
468 *	copyPtr's internal rep is set to the pixel corresponding to
469 *	srcPtr's internal rep.
470 *
471 *----------------------------------------------------------------------
472 */
473
474static void
475DupMMInternalRep(srcPtr, copyPtr)
476    register Tcl_Obj *srcPtr;	/* Object with internal rep to copy. */
477    register Tcl_Obj *copyPtr;	/* Object with internal rep to set. */
478{
479    MMRep *oldPtr, *newPtr;
480
481    copyPtr->typePtr = srcPtr->typePtr;
482    oldPtr = (MMRep *) srcPtr->internalRep.otherValuePtr;
483    newPtr = (MMRep *) ckalloc(sizeof(MMRep));
484    newPtr->value = oldPtr->value;
485    newPtr->units = oldPtr->units;
486    newPtr->tkwin = oldPtr->tkwin;
487    newPtr->returnValue = oldPtr->returnValue;
488    copyPtr->internalRep.otherValuePtr = (VOID *) newPtr;
489}
490
491/*
492 *----------------------------------------------------------------------
493 *
494 * UpdateStringOfMM --
495 *
496 *      Update the string representation for a pixel Tcl_Obj
497 *      this function is only called, if the pixel Tcl_Obj has no unit,
498 *      because with units the string representation is created by
499 *      SetMMFromAny
500 *
501 * Results:
502 *      None.
503 *
504 * Side effects:
505 *      The object's string is set to a valid string that results from
506 *      the double-to-string conversion.
507 *
508 *----------------------------------------------------------------------
509 */
510
511static void
512UpdateStringOfMM(objPtr)
513    register Tcl_Obj *objPtr;   /* pixel obj with string rep to update. */
514{
515    MMRep *mmPtr;
516    char buffer[TCL_DOUBLE_SPACE];
517    register int len;
518
519    mmPtr = (MMRep *) objPtr->internalRep.otherValuePtr;
520    /* assert( mmPtr->units == -1 && objPtr->bytes == NULL ); */
521    if ((mmPtr->units != -1) || (objPtr->bytes != NULL)) {
522        panic("UpdateStringOfMM: false precondition");
523    }
524
525    Tcl_PrintDouble((Tcl_Interp *) NULL, mmPtr->value, buffer);
526    len = strlen(buffer);
527
528    objPtr->bytes = (char *) ckalloc((unsigned) len + 1);
529    strcpy(objPtr->bytes, buffer);
530    objPtr->length = len;
531}
532
533/*
534 *----------------------------------------------------------------------
535 *
536 * SetMMFromAny --
537 *
538 *	Attempt to generate a mm internal form for the Tcl object
539 *	"objPtr".
540 *
541 * Results:
542 *	The return value is a standard Tcl result. If an error occurs during
543 *	conversion, an error message is left in the interpreter's result
544 *	unless "interp" is NULL.
545 *
546 * Side effects:
547 *	If no error occurs, a mm representation of the object is
548 *	stored internally and the type of "objPtr" is set to mm.
549 *
550 *----------------------------------------------------------------------
551 */
552
553static int
554SetMMFromAny(interp, objPtr)
555    Tcl_Interp *interp;		/* Used for error reporting if not NULL. */
556    Tcl_Obj *objPtr;		/* The object to convert. */
557{
558    Tcl_ObjType *typePtr;
559    char *string, *rest;
560    double d;
561    int units;
562    MMRep *mmPtr;
563
564    static Tcl_ObjType *tclDoubleObjType = NULL;
565    static Tcl_ObjType *tclIntObjType = NULL;
566
567    if (tclDoubleObjType == NULL) {
568	/*
569	 * Cache the object types for comaprison below.
570	 * This allows optimized checks for standard cases.
571	 */
572
573	tclDoubleObjType = Tcl_GetObjType("double");
574	tclIntObjType    = Tcl_GetObjType("int");
575    }
576
577    if (objPtr->typePtr == tclDoubleObjType) {
578	Tcl_GetDoubleFromObj(interp, objPtr, &d);
579	units = -1;
580    } else if (objPtr->typePtr == tclIntObjType) {
581	Tcl_GetIntFromObj(interp, objPtr, &units);
582	d = (double) units;
583	units = -1;
584
585	/*
586	 * In the case of ints, we need to ensure that a valid
587	 * string exists in order for int-but-not-string objects
588	 * to be converted back to ints again from mm obj types.
589	 */
590	(void) Tcl_GetStringFromObj(objPtr, NULL);
591    } else {
592	/*
593	 * It wasn't a known int or double, so parse it.
594	 */
595
596	string = Tcl_GetStringFromObj(objPtr, NULL);
597
598	d = strtod(string, &rest);
599	if (rest == string) {
600	    /*
601	     * Must copy string before resetting the result in case a caller
602	     * is trying to convert the interpreter's result to mms.
603	     */
604
605	    error:
606            Tcl_AppendResult(interp, "bad screen distance \"", string,
607                    "\"", (char *) NULL);
608            return TCL_ERROR;
609        }
610        while ((*rest != '\0') && isspace(UCHAR(*rest))) {
611            rest++;
612        }
613        switch (*rest) {
614	    case '\0':
615		units = -1;
616		break;
617
618	    case 'c':
619		units = 0;
620		break;
621
622	    case 'i':
623		units = 1;
624		break;
625
626	    case 'm':
627		units = 2;
628		break;
629
630	    case 'p':
631		units = 3;
632		break;
633
634	    default:
635		goto error;
636	}
637    }
638
639    /*
640     * Free the old internalRep before setting the new one.
641     */
642
643    typePtr = objPtr->typePtr;
644    if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
645	(*typePtr->freeIntRepProc)(objPtr);
646    }
647
648    objPtr->typePtr	= &mmObjType;
649
650    mmPtr		= (MMRep *) ckalloc(sizeof(MMRep));
651    mmPtr->value	= d;
652    mmPtr->units	= units;
653    mmPtr->tkwin	= NULL;
654    mmPtr->returnValue	= d;
655
656    objPtr->internalRep.otherValuePtr = (VOID *) mmPtr;
657
658    return TCL_OK;
659}
660
661/*
662 *----------------------------------------------------------------------
663 *
664 * TkGetWindowFromObj --
665 *
666 *	Attempt to return a Tk_Window from the Tcl object "objPtr". If the
667 *	object is not already a Tk_Window, an attempt will be made to convert
668 *	it to one.
669 *
670 * Results:
671 *	The return value is a standard Tcl object result. If an error occurs
672 *	during conversion, an error message is left in the interpreter's
673 *	result unless "interp" is NULL.
674 *
675 * Side effects:
676 *	If the object is not already a Tk_Window, the conversion will free
677 *	any old internal representation.
678 *
679 *----------------------------------------------------------------------
680 */
681
682int
683TkGetWindowFromObj(interp, tkwin, objPtr, windowPtr)
684    Tcl_Interp *interp; 	/* Used for error reporting if not NULL. */
685    Tk_Window tkwin;		/* A token to get the main window from. */
686    Tcl_Obj *objPtr;		/* The object from which to get window. */
687    Tk_Window *windowPtr;	/* Place to store resulting window. */
688{
689    TkMainInfo *mainPtr = ((TkWindow *)tkwin)->mainPtr;
690    register WindowRep *winPtr;
691    int result;
692
693    result = Tcl_ConvertToType(interp, objPtr, &windowObjType);
694    if (result != TCL_OK) {
695	return result;
696    }
697
698    winPtr = (WindowRep *) objPtr->internalRep.otherValuePtr;
699    if (    winPtr->tkwin == NULL
700	 || winPtr->mainPtr == NULL
701	 || winPtr->mainPtr != mainPtr
702	 || winPtr->epoch != mainPtr->deletionEpoch)
703    {
704	/* Cache is invalid.
705	 */
706	winPtr->tkwin = Tk_NameToWindow(interp,
707		Tcl_GetStringFromObj(objPtr, NULL), tkwin);
708	winPtr->mainPtr = mainPtr;
709	winPtr->epoch = mainPtr ? mainPtr->deletionEpoch : 0;
710    }
711
712    *windowPtr = winPtr->tkwin;
713
714    if (winPtr->tkwin == NULL) {
715	/* ASSERT: Tk_NameToWindow has left error message in interp */
716	return TCL_ERROR;
717    }
718    return TCL_OK;
719}
720
721/*
722 *----------------------------------------------------------------------
723 *
724 * SetWindowFromAny --
725 *	Generate a windowObj internal form for the Tcl object "objPtr".
726 *
727 * Results:
728 *	Always returns TCL_OK.
729 *
730 * Side effects:
731 *	Sets objPtr's internal representation to an uninitialized
732 *	windowObj. Frees the old internal representation, if any.
733 *
734 * See also:
735 * 	TkGetWindowFromObj, which initializes the WindowRep cache.
736 *
737 *----------------------------------------------------------------------
738 */
739
740static int
741SetWindowFromAny(interp, objPtr)
742    Tcl_Interp *interp;		/* Used for error reporting if not NULL. */
743    register Tcl_Obj *objPtr;	/* The object to convert. */
744{
745    Tcl_ObjType *typePtr;
746    WindowRep *winPtr;
747
748    /*
749     * Free the old internalRep before setting the new one.
750     */
751
752    Tcl_GetStringFromObj(objPtr, NULL);
753    typePtr = objPtr->typePtr;
754    if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
755	(*typePtr->freeIntRepProc)(objPtr);
756    }
757
758    winPtr = (WindowRep *) ckalloc(sizeof(WindowRep));
759    winPtr->tkwin = NULL;
760    winPtr->mainPtr = NULL;
761    winPtr->epoch = 0;
762
763    objPtr->internalRep.otherValuePtr = (VOID*)winPtr;
764    objPtr->typePtr = &windowObjType;
765
766    return TCL_OK;
767}
768
769/*
770 *----------------------------------------------------------------------
771 *
772 * DupWindowInternalRep --
773 *
774 *	Initialize the internal representation of a window Tcl_Obj to a
775 *	copy of the internal representation of an existing window object.
776 *
777 * Results:
778 *	None.
779 *
780 * Side effects:
781 *	copyPtr's internal rep is set to refer to the same window as
782 *	srcPtr's internal rep.
783 *
784 *----------------------------------------------------------------------
785 */
786
787static void
788DupWindowInternalRep(srcPtr, copyPtr)
789    register Tcl_Obj *srcPtr;
790    register Tcl_Obj *copyPtr;
791{
792    register WindowRep *oldPtr, *newPtr;
793
794    oldPtr = srcPtr->internalRep.otherValuePtr;
795    newPtr = (WindowRep *) ckalloc(sizeof(WindowRep));
796    newPtr->tkwin = oldPtr->tkwin;
797    newPtr->mainPtr = oldPtr->mainPtr;
798    newPtr->epoch = oldPtr->epoch;
799    copyPtr->internalRep.otherValuePtr = (VOID *)newPtr;
800    copyPtr->typePtr = srcPtr->typePtr;
801}
802
803/*
804 *----------------------------------------------------------------------
805 *
806 * FreeWindowInternalRep --
807 *
808 *	Deallocate the storage associated with a window object's internal
809 *	representation.
810 *
811 * Results:
812 *	None.
813 *
814 * Side effects:
815 *	Frees objPtr's internal representation and sets objPtr's
816 *	internalRep to NULL.
817 *
818 *----------------------------------------------------------------------
819 */
820
821static void
822FreeWindowInternalRep(objPtr)
823    Tcl_Obj *objPtr;		/* Window object with internal rep to free. */
824{
825    ckfree((char *) objPtr->internalRep.otherValuePtr);
826    objPtr->internalRep.otherValuePtr = NULL;
827    objPtr->typePtr = NULL;
828}
829
830/*
831 *--------------------------------------------------------------
832 *
833 * TkParsePadAmount --
834 *
835 *	This procedure parses a padding specification and returns
836 *	the appropriate padding values.  A padding specification can
837 *	be either a single pixel width, or a list of two pixel widths.
838 *	If a single pixel width, the amount specified is used for
839 *	padding on both sides.  If two amounts are specified, then
840 *	they specify the left/right or top/bottom padding.
841 *
842 * Results:
843 *	A standard Tcl return value.
844 *
845 * Side effects:
846 *	An error message is written to the interpreter is something
847 *	is not right.
848 *
849 *--------------------------------------------------------------
850 */
851
852int
853TkParsePadAmount(interp, tkwin, specObj, halfPtr, allPtr)
854    Tcl_Interp *interp;		/* Interpreter for error reporting. */
855    Tk_Window tkwin;		/* A window.  Needed by Tk_GetPixels() */
856    Tcl_Obj *specObj;		/* The argument to "-padx", "-pady", "-ipadx",
857				 * or "-ipady".  The thing to be parsed. */
858    int *halfPtr;		/* Write the left/top part of padding here */
859    int *allPtr;		/* Write the total padding here */
860{
861    int firstInt, secondInt;    /* The two components of the padding */
862    int objc;			/* The length of the list (should be 1 or 2) */
863    Tcl_Obj **objv;		/* The objects in the list */
864
865    /*
866     * Check for a common case where a single object would otherwise
867     * be shimmered between a list and a pixel spec.
868     */
869
870    if (specObj->typePtr == &pixelObjType) {
871	if (Tk_GetPixelsFromObj(interp, tkwin, specObj, &firstInt) != TCL_OK) {
872	    Tcl_ResetResult(interp);
873	    Tcl_AppendResult(interp, "bad pad value \"",
874		    Tcl_GetString(specObj),
875		    "\": must be positive screen distance", (char *) NULL);
876	    return TCL_ERROR;
877	}
878	secondInt = firstInt;
879	goto done;
880    }
881
882    /*
883     * Pad specifications are a list of one or two elements, each of
884     * which is a pixel specification.
885     */
886
887    if (Tcl_ListObjGetElements(interp, specObj, &objc, &objv) != TCL_OK) {
888	return TCL_ERROR;
889    }
890    if (objc != 1 && objc != 2) {
891	Tcl_AppendResult(interp,
892		"wrong number of parts to pad specification", NULL);
893	return TCL_ERROR;
894    }
895
896    /*
897     * Parse the first part.
898     */
899
900    if (Tk_GetPixelsFromObj(interp, tkwin, objv[0], &firstInt) != TCL_OK ||
901	    (firstInt < 0)) {
902	Tcl_ResetResult(interp);
903	Tcl_AppendResult(interp, "bad pad value \"", Tcl_GetString(objv[0]),
904		"\": must be positive screen distance", (char *) NULL);
905	return TCL_ERROR;
906    }
907
908    /*
909     * Parse the second part if it exists, otherwise it is as if it
910     * was the same as the first part.
911     */
912
913    if (objc == 1) {
914	secondInt = firstInt;
915    } else if (Tk_GetPixelsFromObj(interp, tkwin, objv[1],
916	    &secondInt) != TCL_OK || (secondInt < 0)) {
917	Tcl_ResetResult(interp);
918	Tcl_AppendResult(interp, "bad 2nd pad value \"",
919		Tcl_GetString(objv[1]),
920		"\": must be positive screen distance", (char *) NULL);
921	return TCL_ERROR;
922    }
923
924    /*
925     * Write the parsed bits back into the receiving variables.
926     */
927
928  done:
929    if (halfPtr != 0) {
930	*halfPtr = firstInt;
931    }
932    *allPtr = firstInt + secondInt;
933    return TCL_OK;
934}
935
936/*
937 *----------------------------------------------------------------------
938 *
939 * TkRegisterObjTypes --
940 *
941 *	Registers Tk's Tcl_ObjType structures with the Tcl run-time.
942 *
943 * Results:
944 *	None
945 *
946 * Side effects:
947 *	All instances of Tcl_ObjType structues used in Tk are registered
948 *	with Tcl.
949 *
950 *----------------------------------------------------------------------
951 */
952
953void
954TkRegisterObjTypes()
955{
956    Tcl_RegisterObjType(&tkBorderObjType);
957    Tcl_RegisterObjType(&tkBitmapObjType);
958    Tcl_RegisterObjType(&tkColorObjType);
959    Tcl_RegisterObjType(&tkCursorObjType);
960    Tcl_RegisterObjType(&tkFontObjType);
961    Tcl_RegisterObjType(&mmObjType);
962    Tcl_RegisterObjType(&tkOptionObjType);
963    Tcl_RegisterObjType(&pixelObjType);
964    Tcl_RegisterObjType(&tkStateKeyObjType);
965    Tcl_RegisterObjType(&windowObjType);
966}
967