Backport of the Millipeter patch [1813597,2218964]

4 files changed, 117 insertions, 19 deletions

diff --git a/generic/tkCanvUtil.c b/generic/tkCanvUtil.c
index e0c9a3a..9bd60d4 100644
--- a/generic/tkCanvUtil.c
+++ b/generic/tkCanvUtil.c
@@ -9,7 +9,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tkCanvUtil.c,v 1.19 2008/03/11 22:31:19 das Exp $
+ * RCS: @(#) $Id: tkCanvUtil.c,v 1.19.2.1 2008/12/21 23:52:45 ferrieux Exp $
  */
 
 #include "tkInt.h"
@@ -268,12 +268,7 @@ Tk_CanvasGetCoordFromObj(
 {
     TkCanvas *canvasPtr = (TkCanvas *) canvas;
 
-    if (Tk_GetMMFromObj(canvasPtr->interp, canvasPtr->tkwin, obj,
-	    doublePtr) != TCL_OK) {
-	return TCL_ERROR;
-    }
-    *doublePtr *= canvasPtr->pixelsPerMM;
-    return TCL_OK;
+    return Tk_GetDoublePixelsFromObj(canvasPtr->interp, canvasPtr->tkwin, obj, doublePtr);
 }
 
 /*
diff --git a/generic/tkInt.h b/generic/tkInt.h
index 3563ceb..5139a9f 100644
--- a/generic/tkInt.h
+++ b/generic/tkInt.h
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: $Id: tkInt.h,v 1.82.2.1 2008/04/02 21:49:31 das Exp $
+ * RCS: $Id: tkInt.h,v 1.82.2.2 2008/12/21 23:52:45 ferrieux Exp $
  */
 
 #ifndef _TKINT
@@ -1111,6 +1111,11 @@ MODULE_SCOPE int	Tk_WinfoObjCmd(ClientData clientData,
 MODULE_SCOPE int	Tk_WmObjCmd(ClientData clientData, Tcl_Interp *interp,
 			    int objc, Tcl_Obj *const objv[]);
 
+MODULE_SCOPE int	Tk_GetDoublePixelsFromObj(Tcl_Interp *interp,
+						  Tk_Window tkwin,
+						  Tcl_Obj *objPtr,
+						  double *doublePtr);
+
 MODULE_SCOPE void	TkEventInit(void);
 MODULE_SCOPE void	TkRegisterObjTypes(void);
 MODULE_SCOPE int	TkCreateMenuCmd(Tcl_Interp *interp);
diff --git a/generic/tkObj.c b/generic/tkObj.c
index 15f01ac..c425864 100644
--- a/generic/tkObj.c
+++ b/generic/tkObj.c
@@ -8,7 +8,7 @@
  * 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.19 2007/12/13 15:24:16 dgp Exp $
+ * RCS: @(#) $Id: tkObj.c,v 1.19.2.1 2008/12/21 23:52:45 ferrieux Exp $
  */
 
 #include "tkInt.h"
@@ -125,7 +125,7 @@ static Tcl_ObjType windowObjType = {
 /*
  *----------------------------------------------------------------------
  *
- * Tk_GetPixelsFromObj --
+ * GetPixelsFromObjEx --
  *
  *	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
@@ -143,32 +143,50 @@ static Tcl_ObjType windowObjType = {
  *----------------------------------------------------------------------
  */
 
+static
 int
-Tk_GetPixelsFromObj(
+GetPixelsFromObjEx(
     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 *intPtr,
+    double *dblPtr)		/* Places to store resulting pixels. */
 {
-    int result;
+    int result,fresh;
     double d;
     PixelRep *pixelPtr;
     static double bias[] = {
 	1.0,	10.0,	25.4,	0.35278 /*25.4 / 72.0*/
     };
 
+ retry:
     if (objPtr->typePtr != &pixelObjType) {
 	result = SetPixelFromAny(interp, objPtr);
 	if (result != TCL_OK) {
 	    return result;
 	}
+	fresh=1;
+    } else {
+	fresh=0;
     }
 
     if (SIMPLE_PIXELREP(objPtr)) {
 	*intPtr = GET_SIMPLEPIXEL(objPtr);
+	if (dblPtr) {
+	    *dblPtr=(double)(*intPtr);
+	}
     } else {
 	pixelPtr = GET_COMPLEXPIXEL(objPtr);
-	if (pixelPtr->tkwin != tkwin) {
+	if ((!fresh) && (pixelPtr->tkwin != tkwin))
+	    {
+		/* in case of exo-screen conversions of non-pixels
+		 * we force a recomputation from the string
+		 */
+
+		FreePixelInternalRep(objPtr);
+		goto retry;
+	    }
+	if ((pixelPtr->tkwin != tkwin)||dblPtr) {
 	    d = pixelPtr->value;
 	    if (pixelPtr->units >= 0) {
 		d *= bias[pixelPtr->units] * WidthOfScreen(Tk_Screen(tkwin));
@@ -180,6 +198,9 @@ Tk_GetPixelsFromObj(
 		pixelPtr->returnValue = (int) (d + 0.5);
 	    }
 	    pixelPtr->tkwin = tkwin;
+	    if (dblPtr) {
+		*dblPtr=(double)d;
+	    }
 	}
 	*intPtr = pixelPtr->returnValue;
     }
@@ -189,6 +210,85 @@ Tk_GetPixelsFromObj(
 /*
  *----------------------------------------------------------------------
  *
+ * 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(
+    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. */
+{
+    return GetPixelsFromObjEx(interp,tkwin,objPtr,intPtr,NULL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetDoublePixelsFromObj --
+ *
+ *	Attempt  to  return   a  double  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, the internal unit being pixels.
+ *
+ * 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_GetDoublePixelsFromObj(
+    Tcl_Interp *interp, 	/* Used for error reporting if not NULL. */
+    Tk_Window tkwin,
+    Tcl_Obj *objPtr,		/* The object from which to get pixels. */
+    double *doublePtr)		/* Place to store resulting pixels. */
+{
+    double d;
+    int result,val;
+
+    result=GetPixelsFromObjEx(interp, tkwin, objPtr, &val, &d);
+    if (result != TCL_OK) {
+	return result;
+    }
+    if (!SIMPLE_PIXELREP(objPtr)) {
+	PixelRep *pixelPtr;
+	pixelPtr = GET_COMPLEXPIXEL(objPtr);
+	if (pixelPtr->units >= 0) {
+	    /* internally "shimmer" to pixel units */
+	    pixelPtr->units=-1;
+	    pixelPtr->value=d;
+	}
+    }
+    *doublePtr = d;
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * FreePixelInternalRep --
  *
  *	Deallocate the storage associated with a pixel object's internal
diff --git a/generic/tkText.c b/generic/tkText.c
index 21077df..fb2f9b1 100644
--- a/generic/tkText.c
+++ b/generic/tkText.c
@@ -13,7 +13,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tkText.c,v 1.79.2.1 2008/12/07 16:48:00 das Exp $
+ * RCS: @(#) $Id: tkText.c,v 1.79.2.2 2008/12/21 23:52:45 ferrieux Exp $
  */
 
 #include "default.h"
@@ -4326,12 +4326,10 @@ TkTextGetTabs(
 	}
 
 	prevStop = lastStop;
-	if (Tk_GetMMFromObj(interp, textPtr->tkwin, objv[i],
-		&lastStop) != TCL_OK) {
+	if (Tk_GetDoublePixelsFromObj (interp, textPtr->tkwin, objv[i],
+				       &lastStop) != TCL_OK) {
 	    goto error;
 	}
-	lastStop *= WidthOfScreen(Tk_Screen(textPtr->tkwin));
-	lastStop /= WidthMMOfScreen(Tk_Screen(textPtr->tkwin));
 
 	if (i > 0 && (tabPtr->location <= (tabPtr-1)->location)) {
 	    /*