summaryrefslogtreecommitdiffstats
path: root/generic/tkObj.c
diff options
context:
space:
mode:
authorstanton <stanton>1999-04-16 01:51:06 (GMT)
committerstanton <stanton>1999-04-16 01:51:06 (GMT)
commit03656f44f81469f459031fa3a4a7b09c8bc77712 (patch)
tree31378e81bd58f8c726fc552d6b30cbf3ca07497b /generic/tkObj.c
parent404fc236f34304df53b7e44bc7971d786b87d453 (diff)
downloadtk-03656f44f81469f459031fa3a4a7b09c8bc77712.zip
tk-03656f44f81469f459031fa3a4a7b09c8bc77712.tar.gz
tk-03656f44f81469f459031fa3a4a7b09c8bc77712.tar.bz2
* Merged 8.1 branch into the main trunk
Diffstat (limited to 'generic/tkObj.c')
-rw-r--r--generic/tkObj.c659
1 files changed, 659 insertions, 0 deletions
diff --git a/generic/tkObj.c b/generic/tkObj.c
new file mode 100644
index 0000000..ff2684c
--- /dev/null
+++ b/generic/tkObj.c
@@ -0,0 +1,659 @@
+/*
+ * tkObj.c --
+ *
+ * This file contains procedures that implement the common Tk object
+ * types
+ *
+ * Copyright (c) 1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id: tkObj.c,v 1.2 1999/04/16 01:51:20 stanton Exp $
+ */
+
+#include "tkInt.h"
+
+/*
+ * The following structure is the internal representation for pixel objects.
+ */
+
+typedef struct PixelRep {
+ double value;
+ int units;
+ Tk_Window tkwin;
+ int returnValue;
+} PixelRep;
+
+#define SIMPLE_PIXELREP(objPtr) \
+ ((objPtr)->internalRep.twoPtrValue.ptr2 == 0)
+
+#define SET_SIMPLEPIXEL(objPtr, intval) \
+ (objPtr)->internalRep.twoPtrValue.ptr1 = (VOID *) (intval); \
+ (objPtr)->internalRep.twoPtrValue.ptr2 = 0
+
+#define GET_SIMPLEPIXEL(objPtr) \
+ ((int) (objPtr)->internalRep.twoPtrValue.ptr1)
+
+#define SET_COMPLEXPIXEL(objPtr, repPtr) \
+ (objPtr)->internalRep.twoPtrValue.ptr1 = 0; \
+ (objPtr)->internalRep.twoPtrValue.ptr2 = (VOID *) repPtr
+
+#define GET_COMPLEXPIXEL(objPtr) \
+ ((PixelRep *) (objPtr)->internalRep.twoPtrValue.ptr2)
+
+
+/*
+ * The following structure is the internal representation for mm objects.
+ */
+
+typedef struct MMRep {
+ double value;
+ int units;
+ Tk_Window tkwin;
+ double returnValue;
+} MMRep;
+
+/*
+ * Prototypes for procedures defined later in this file:
+ */
+
+static void DupMMInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
+ Tcl_Obj *copyPtr));
+static void DupPixelInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
+ Tcl_Obj *copyPtr));
+static void FreeMMInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr));
+static void FreePixelInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr));
+static int SetMMFromAny _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *objPtr));
+static int SetPixelFromAny _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *objPtr));
+static int SetWindowFromAny _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *objPtr));
+
+/*
+ * The following structure defines the implementation of the "pixel"
+ * Tcl object, used for measuring distances. The pixel object remembers
+ * its initial display-independant settings.
+ */
+
+static Tcl_ObjType pixelObjType = {
+ "pixel", /* name */
+ FreePixelInternalRep, /* freeIntRepProc */
+ DupPixelInternalRep, /* dupIntRepProc */
+ NULL, /* updateStringProc */
+ SetPixelFromAny /* setFromAnyProc */
+};
+
+/*
+ * The following structure defines the implementation of the "pixel"
+ * Tcl object, used for measuring distances. The pixel object remembers
+ * its initial display-independant settings.
+ */
+
+static Tcl_ObjType mmObjType = {
+ "mm", /* name */
+ FreeMMInternalRep, /* freeIntRepProc */
+ DupMMInternalRep, /* dupIntRepProc */
+ NULL, /* updateStringProc */
+ SetMMFromAny /* setFromAnyProc */
+};
+
+/*
+ * The following structure defines the implementation of the "window"
+ * Tcl object.
+ */
+
+static Tcl_ObjType windowObjType = {
+ "window", /* name */
+ (Tcl_FreeInternalRepProc *) NULL, /* freeIntRepProc */
+ (Tcl_DupInternalRepProc *) NULL, /* dupIntRepProc */
+ NULL, /* updateStringProc */
+ SetWindowFromAny /* setFromAnyProc */
+};
+
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetPixelsFromObj --
+ *
+ * Attempt to return a pixel value from the Tcl object "objPtr". If the
+ * object is not already a pixel value, an attempt will be made to convert
+ * it to one.
+ *
+ * Results:
+ * The return value is a standard Tcl object result. If an error occurs
+ * during conversion, an error message is left in the interpreter's
+ * result unless "interp" is NULL.
+ *
+ * Side effects:
+ * If the object is not already a pixel, the conversion will free
+ * any old internal representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_GetPixelsFromObj(interp, tkwin, objPtr, intPtr)
+ Tcl_Interp *interp; /* Used for error reporting if not NULL. */
+ Tk_Window tkwin;
+ Tcl_Obj *objPtr; /* The object from which to get pixels. */
+ int *intPtr; /* Place to store resulting pixels. */
+{
+ int result;
+ double d;
+ PixelRep *pixelPtr;
+ static double bias[] = {
+ 1.0, 10.0, 25.4, 25.4 / 72.0
+ };
+
+ if (objPtr->typePtr != &pixelObjType) {
+ result = SetPixelFromAny(interp, objPtr);
+ if (result != TCL_OK) {
+ return result;
+ }
+ }
+
+ if (SIMPLE_PIXELREP(objPtr)) {
+ *intPtr = GET_SIMPLEPIXEL(objPtr);
+ } else {
+ pixelPtr = GET_COMPLEXPIXEL(objPtr);
+ if (pixelPtr->tkwin != tkwin) {
+ d = pixelPtr->value;
+ if (pixelPtr->units >= 0) {
+ d *= bias[pixelPtr->units] * WidthOfScreen(Tk_Screen(tkwin));
+ d /= WidthMMOfScreen(Tk_Screen(tkwin));
+ }
+ if (d < 0) {
+ pixelPtr->returnValue = (int) (d - 0.5);
+ } else {
+ pixelPtr->returnValue = (int) (d + 0.5);
+ }
+ pixelPtr->tkwin = tkwin;
+ }
+ *intPtr = pixelPtr->returnValue;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreePixelInternalRep --
+ *
+ * Deallocate the storage associated with a pixel object's internal
+ * representation.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Frees objPtr's internal representation and sets objPtr's
+ * internalRep to NULL.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreePixelInternalRep(objPtr)
+ Tcl_Obj *objPtr; /* Pixel object with internal rep to free. */
+{
+ PixelRep *pixelPtr;
+
+ if (!SIMPLE_PIXELREP(objPtr)) {
+ pixelPtr = GET_COMPLEXPIXEL(objPtr);
+ ckfree((char *) pixelPtr);
+ }
+ SET_SIMPLEPIXEL(objPtr, 0);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DupPixelInternalRep --
+ *
+ * Initialize the internal representation of a pixel Tcl_Obj to a
+ * copy of the internal representation of an existing pixel object.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * copyPtr's internal rep is set to the pixel corresponding to
+ * srcPtr's internal rep.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DupPixelInternalRep(srcPtr, copyPtr)
+ register Tcl_Obj *srcPtr; /* Object with internal rep to copy. */
+ register Tcl_Obj *copyPtr; /* Object with internal rep to set. */
+{
+ PixelRep *oldPtr, *newPtr;
+
+ copyPtr->typePtr = srcPtr->typePtr;
+
+ if (SIMPLE_PIXELREP(srcPtr)) {
+ SET_SIMPLEPIXEL(copyPtr, GET_SIMPLEPIXEL(srcPtr));
+ } else {
+ oldPtr = GET_COMPLEXPIXEL(srcPtr);
+ newPtr = (PixelRep *) ckalloc(sizeof(PixelRep));
+ newPtr->value = oldPtr->value;
+ newPtr->units = oldPtr->units;
+ newPtr->tkwin = oldPtr->tkwin;
+ newPtr->returnValue = oldPtr->returnValue;
+ SET_COMPLEXPIXEL(copyPtr, newPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetPixelFromAny --
+ *
+ * Attempt to generate a pixel internal form for the Tcl object
+ * "objPtr".
+ *
+ * Results:
+ * The return value is a standard Tcl result. If an error occurs during
+ * conversion, an error message is left in the interpreter's result
+ * unless "interp" is NULL.
+ *
+ * Side effects:
+ * If no error occurs, a pixel representation of the object is
+ * stored internally and the type of "objPtr" is set to pixel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetPixelFromAny(interp, objPtr)
+ Tcl_Interp *interp; /* Used for error reporting if not NULL. */
+ Tcl_Obj *objPtr; /* The object to convert. */
+{
+ Tcl_ObjType *typePtr;
+ char *string, *rest;
+ double d;
+ int i, units;
+ PixelRep *pixelPtr;
+
+ string = Tcl_GetStringFromObj(objPtr, NULL);
+
+ d = strtod(string, &rest);
+ if (rest == string) {
+ /*
+ * Must copy string before resetting the result in case a caller
+ * is trying to convert the interpreter's result to pixels.
+ */
+
+ char buf[100];
+
+ error:
+ sprintf(buf, "bad screen distance \"%.50s\"", string);
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, buf, NULL);
+ return TCL_ERROR;
+ }
+ while ((*rest != '\0') && isspace(UCHAR(*rest))) {
+ rest++;
+ }
+ switch (*rest) {
+ case '\0':
+ units = -1;
+ break;
+
+ case 'm':
+ units = 0;
+ break;
+
+ case 'c':
+ units = 1;
+ break;
+
+ case 'i':
+ units = 2;
+ break;
+
+ case 'p':
+ units = 3;
+ break;
+
+ default:
+ goto error;
+ }
+
+ /*
+ * Free the old internalRep before setting the new one.
+ */
+
+ typePtr = objPtr->typePtr;
+ if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
+ (*typePtr->freeIntRepProc)(objPtr);
+ }
+
+ objPtr->typePtr = &pixelObjType;
+
+ i = (int) d;
+ if ((units < 0) && (i == d)) {
+ SET_SIMPLEPIXEL(objPtr, i);
+ } else {
+ pixelPtr = (PixelRep *) ckalloc(sizeof(PixelRep));
+ pixelPtr->value = d;
+ pixelPtr->units = units;
+ pixelPtr->tkwin = NULL;
+ pixelPtr->returnValue = i;
+ SET_COMPLEXPIXEL(objPtr, pixelPtr);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetMMFromObj --
+ *
+ * Attempt to return an mm value from the Tcl object "objPtr". If the
+ * object is not already an mm value, an attempt will be made to convert
+ * it to one.
+ *
+ * Results:
+ * The return value is a standard Tcl object result. If an error occurs
+ * during conversion, an error message is left in the interpreter's
+ * result unless "interp" is NULL.
+ *
+ * Side effects:
+ * If the object is not already a pixel, the conversion will free
+ * any old internal representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_GetMMFromObj(interp, tkwin, objPtr, doublePtr)
+ Tcl_Interp *interp; /* Used for error reporting if not NULL. */
+ Tk_Window tkwin;
+ Tcl_Obj *objPtr; /* The object from which to get mms. */
+ double *doublePtr; /* Place to store resulting millimeters. */
+{
+ int result;
+ double d;
+ MMRep *mmPtr;
+ static double bias[] = {
+ 10.0, 25.4, 1.0, 25.4 / 72.0
+ };
+
+ if (objPtr->typePtr != &mmObjType) {
+ result = SetMMFromAny(interp, objPtr);
+ if (result != TCL_OK) {
+ return result;
+ }
+ }
+
+ mmPtr = (MMRep *) objPtr->internalRep.otherValuePtr;
+ if (mmPtr->tkwin != tkwin) {
+ d = mmPtr->value;
+ if (mmPtr->units == -1) {
+ d /= WidthOfScreen(Tk_Screen(tkwin));
+ d *= WidthMMOfScreen(Tk_Screen(tkwin));
+ } else {
+ d *= bias[mmPtr->units];
+ }
+ mmPtr->tkwin = tkwin;
+ mmPtr->returnValue = d;
+ }
+ *doublePtr = mmPtr->returnValue;
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeMMInternalRep --
+ *
+ * Deallocate the storage associated with a mm object's internal
+ * representation.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Frees objPtr's internal representation and sets objPtr's
+ * internalRep to NULL.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeMMInternalRep(objPtr)
+ Tcl_Obj *objPtr; /* MM object with internal rep to free. */
+{
+ ckfree((char *) objPtr->internalRep.otherValuePtr);
+ objPtr->internalRep.otherValuePtr = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DupMMInternalRep --
+ *
+ * Initialize the internal representation of a pixel Tcl_Obj to a
+ * copy of the internal representation of an existing pixel object.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * copyPtr's internal rep is set to the pixel corresponding to
+ * srcPtr's internal rep.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DupMMInternalRep(srcPtr, copyPtr)
+ register Tcl_Obj *srcPtr; /* Object with internal rep to copy. */
+ register Tcl_Obj *copyPtr; /* Object with internal rep to set. */
+{
+ MMRep *oldPtr, *newPtr;
+
+ copyPtr->typePtr = srcPtr->typePtr;
+ oldPtr = (MMRep *) srcPtr->internalRep.otherValuePtr;
+ newPtr = (MMRep *) ckalloc(sizeof(MMRep));
+ newPtr->value = oldPtr->value;
+ newPtr->units = oldPtr->units;
+ newPtr->tkwin = oldPtr->tkwin;
+ newPtr->returnValue = oldPtr->returnValue;
+ copyPtr->internalRep.otherValuePtr = (VOID *) newPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetMMFromAny --
+ *
+ * Attempt to generate a mm internal form for the Tcl object
+ * "objPtr".
+ *
+ * Results:
+ * The return value is a standard Tcl result. If an error occurs during
+ * conversion, an error message is left in the interpreter's result
+ * unless "interp" is NULL.
+ *
+ * Side effects:
+ * If no error occurs, a mm representation of the object is
+ * stored internally and the type of "objPtr" is set to mm.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetMMFromAny(interp, objPtr)
+ Tcl_Interp *interp; /* Used for error reporting if not NULL. */
+ Tcl_Obj *objPtr; /* The object to convert. */
+{
+ Tcl_ObjType *typePtr;
+ char *string, *rest;
+ double d;
+ int units;
+ MMRep *mmPtr;
+
+ string = Tcl_GetStringFromObj(objPtr, NULL);
+
+ d = strtod(string, &rest);
+ if (rest == string) {
+ /*
+ * Must copy string before resetting the result in case a caller
+ * is trying to convert the interpreter's result to mms.
+ */
+
+ error:
+ Tcl_AppendResult(interp, "bad screen distance \"", string,
+ "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ while ((*rest != '\0') && isspace(UCHAR(*rest))) {
+ rest++;
+ }
+ switch (*rest) {
+ case '\0':
+ units = -1;
+ break;
+
+ case 'c':
+ units = 0;
+ break;
+
+ case 'i':
+ units = 1;
+ break;
+
+ case 'm':
+ units = 2;
+ break;
+
+ case 'p':
+ units = 3;
+ break;
+
+ default:
+ goto error;
+ }
+
+ /*
+ * Free the old internalRep before setting the new one.
+ */
+
+ typePtr = objPtr->typePtr;
+ if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
+ (*typePtr->freeIntRepProc)(objPtr);
+ }
+
+ objPtr->typePtr = &mmObjType;
+
+ mmPtr = (MMRep *) ckalloc(sizeof(MMRep));
+ mmPtr->value = d;
+ mmPtr->units = units;
+ mmPtr->tkwin = NULL;
+ mmPtr->returnValue = d;
+ objPtr->internalRep.otherValuePtr = (VOID *) mmPtr;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGetWindowFromObj --
+ *
+ * Attempt to return a Tk_Window from the Tcl object "objPtr". If the
+ * object is not already a Tk_Window, an attempt will be made to convert
+ * it to one.
+ *
+ * Results:
+ * The return value is a standard Tcl object result. If an error occurs
+ * during conversion, an error message is left in the interpreter's
+ * result unless "interp" is NULL.
+ *
+ * Side effects:
+ * If the object is not already a Tk_Window, the conversion will free
+ * any old internal representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkGetWindowFromObj(interp, tkwin, objPtr, windowPtr)
+ Tcl_Interp *interp; /* Used for error reporting if not NULL. */
+ Tk_Window tkwin; /* A token to get the main window from. */
+ register Tcl_Obj *objPtr; /* The object from which to get boolean. */
+ Tk_Window *windowPtr; /* Place to store resulting window. */
+{
+ register int result;
+ Tk_Window lastWindow;
+
+ result = SetWindowFromAny(interp, objPtr);
+ if (result != TCL_OK) {
+ return result;
+ }
+
+ lastWindow = (Tk_Window) objPtr->internalRep.twoPtrValue.ptr1;
+ if (tkwin != lastWindow) {
+ Tk_Window foundWindow = Tk_NameToWindow(interp,
+ Tcl_GetStringFromObj(objPtr, NULL), tkwin);
+
+ if (foundWindow == NULL) {
+ return TCL_ERROR;
+ }
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) tkwin;
+ objPtr->internalRep.twoPtrValue.ptr2 = (VOID *) foundWindow;
+ }
+ *windowPtr = (Tk_Window) objPtr->internalRep.twoPtrValue.ptr2;
+
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetWindowFromAny --
+ *
+ * Attempt to generate a Tk_Window internal form for the Tcl object
+ * "objPtr".
+ *
+ * Results:
+ * The return value is a standard Tcl result. If an error occurs during
+ * conversion, an error message is left in the interpreter's result
+ * unless "interp" is NULL.
+ *
+ * Side effects:
+ * If no error occurs, a standard window value is stored as "objPtr"s
+ * internal representation and the type of "objPtr" is set to Tk_Window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetWindowFromAny(interp, objPtr)
+ Tcl_Interp *interp; /* Used for error reporting if not NULL. */
+ register Tcl_Obj *objPtr; /* The object to convert. */
+{
+ Tcl_ObjType *typePtr;
+
+ /*
+ * Free the old internalRep before setting the new one.
+ */
+
+ Tcl_GetStringFromObj(objPtr, NULL);
+ typePtr = objPtr->typePtr;
+ if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
+ (*typePtr->freeIntRepProc)(objPtr);
+ }
+ objPtr->typePtr = &windowObjType;
+ objPtr->internalRep.twoPtrValue.ptr1 = NULL;
+ objPtr->internalRep.twoPtrValue.ptr2 = NULL;
+
+ return TCL_OK;
+}