* tests/canvas.test: added test case to check obj conversion

	* generic/tkObj.c (UpdateStringOfMM, SetMMFromAny): better
	obj-aware screen distances.  (pgbaum, hobbs) [Patch #403327]

3 files changed, 116 insertions, 5 deletions

diff --git a/ChangeLog b/ChangeLog
index 645f34f..52e3ba1 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,24 @@
+2001-03-29  Jeff Hobbs  <jeffh@ActiveState.com>
+
+	* tests/canvas.test: added test case to check obj conversion
+	* generic/tkObj.c (UpdateStringOfMM, SetMMFromAny): better
+	obj-aware screen distances.  (pgbaum, hobbs) [Patch #403327]
+
+	* library/bgerror.tcl (bgerror): allow focus into details window
+	for Windows C&P to work. [Bug #220929]
+
+	* library/tk.tcl: put a catch around adding <hpBackTab> to the
+	<<PrevWindow>> virtual event as it doesn't seem to work on all HP
+	systems. [Bug #411669]
+
+	* library/tkfbox.tcl: fixed selecting directories and single files
+	with spaces using tk_getOpenFile -multiple 1. [Bug #411640]
+
+	* win/tkWinDialog.c (GetFileNameA): added support for -multiple to
+	ascii-based tk_getOpenFile (Win9*). (haneef) [Patch #403047]
+	(GetFileNameW): increased number of files that could be returned
+	by tk_getOpenFile -multiple. [Patch #412042]
+
 2001-03-29  Mo DeJong  <mdejong@redhat.com>
 
 	* library/entry.tcl (tkEntryMouseSelect):
diff --git a/generic/tkObj.c b/generic/tkObj.c
index e27bd4f..b26da1c 100644
--- a/generic/tkObj.c
+++ b/generic/tkObj.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: tkObj.c,v 1.3 2000/12/13 19:44:15 hobbs Exp $
+ * RCS: @(#) $Id: tkObj.c,v 1.4 2001/03/30 07:11:44 hobbs Exp $
  */
 
 #include "tkInt.h"
@@ -64,6 +64,7 @@ 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 void		UpdateStringOfMM _ANSI_ARGS_((Tcl_Obj *objPtr));
 static int		SetMMFromAny _ANSI_ARGS_((Tcl_Interp *interp,
 			    Tcl_Obj *objPtr));
 static int		SetPixelFromAny _ANSI_ARGS_((Tcl_Interp *interp,
@@ -95,7 +96,7 @@ static Tcl_ObjType mmObjType = {
     "mm",			/* name */
     FreeMMInternalRep,		/* freeIntRepProc */
     DupMMInternalRep,		/* dupIntRepProc */
-    NULL,			/* updateStringProc */
+    UpdateStringOfMM,		/* updateStringProc */
     SetMMFromAny		/* setFromAnyProc */
 };
 
@@ -473,6 +474,48 @@ DupMMInternalRep(srcPtr, copyPtr)
 /*
  *----------------------------------------------------------------------
  *
+ * UpdateStringOfMM --
+ *
+ *      Update the string representation for a pixel Tcl_Obj
+ *      this function is only called, if the pixel Tcl_Obj has no unit,
+ *      because with units the string representation is created by
+ *      SetMMFromAny
+ *
+ * Results:
+ *      None.
+ *
+ * Side effects:
+ *      The object's string is set to a valid string that results from
+ *      the double-to-string conversion.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateStringOfMM(objPtr)
+    register Tcl_Obj *objPtr;   /* pixel obj with string rep to update. */
+{
+    MMRep *mmPtr;
+    char buffer[TCL_DOUBLE_SPACE];
+    register int len;
+
+    mmPtr = (MMRep *) objPtr->internalRep.otherValuePtr;
+    /* assert( mmPtr->units == -1 && objPtr->bytes == NULL ); */
+    if ((mmPtr->units != -1) || (objPtr->bytes != NULL)) {
+        panic("UpdateStringOfMM: false precondition");
+    }
+
+    Tcl_PrintDouble((Tcl_Interp *) NULL, mmPtr->value, buffer);
+    len = strlen(buffer);
+
+    objPtr->bytes = (char *) ckalloc((unsigned) len + 1);
+    strcpy(objPtr->bytes, buffer);
+    objPtr->length = len;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * SetMMFromAny --
  *
  *	Attempt to generate a mm internal form for the Tcl object
@@ -501,11 +544,38 @@ SetMMFromAny(interp, objPtr)
     int units;
     MMRep *mmPtr;
 
-    if (objPtr->typePtr == &tclDoubleType) {
-	/* optimize for speed reasons */
+    static Tcl_ObjType *tclDoubleObjType = NULL;
+    static Tcl_ObjType *tclIntObjType = NULL;
+
+    if (tclDoubleObjType == NULL) {
+	/*
+	 * Cache the object types for comaprison below.
+	 * This allows optimized checks for standard cases.
+	 */
+
+	tclDoubleObjType = Tcl_GetObjType("double");
+	tclIntObjType    = Tcl_GetObjType("int");
+    }
+
+    if (objPtr->typePtr == tclDoubleObjType) {
 	Tcl_GetDoubleFromObj(interp, objPtr, &d);
 	units = -1;
+    } else if (objPtr->typePtr == tclIntObjType) {
+	Tcl_GetIntFromObj(interp, objPtr, &units);
+	d = (double) units;
+	units = -1;
+
+	/*
+	 * In the case of ints, we need to ensure that a valid
+	 * string exists in order for int-but-not-string objects
+	 * to be converted back to ints again from mm obj types.
+	 */
+	(void) Tcl_GetStringFromObj(objPtr, NULL);
     } else {
+	/*
+	 * It wasn't a known int or double, so parse it.
+	 */
+
 	string = Tcl_GetStringFromObj(objPtr, NULL);
 
 	d = strtod(string, &rest);
diff --git a/tests/canvas.test b/tests/canvas.test
index 51f178c..9a58a64 100644
--- a/tests/canvas.test
+++ b/tests/canvas.test
@@ -6,7 +6,7 @@
 # Copyright (c) 1998-2000 Ajuba Solutions.
 # All rights reserved.
 #
-# RCS: @(#) $Id: canvas.test,v 1.10 2000/06/06 04:18:13 ericm Exp $
+# RCS: @(#) $Id: canvas.test,v 1.11 2001/03/30 07:11:44 hobbs Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     source [file join [pwd] [file dirname [info script]] defs.tcl]
@@ -367,6 +367,26 @@ test canvas-11.1 {canvas poly fill check, bug 5783} {
 	    -fill {} -stipple gray50 -outline black
 } 1
 
+test canvas-12.1 {canvas mm obj, patch SF-403327, 102471} {
+    destroy .c
+    pack [canvas .c]
+    set qx [expr {1.+1.}] 
+    # qx has type double and no string representation 
+    .c scale all $qx 0 1. 1.
+    # qx has now type MMRep and no string representation 
+    list $qx [string length $qx]
+} {2.0 3}
+test canvas-12.2 {canvas mm obj, patch SF-403327, 102471} {
+    destroy .c
+    pack [canvas .c]
+    set val 10
+    incr val
+    # qx has type double and no string representation 
+    .c scale all $val 0 1 1
+    # qx has now type MMRep and no string representation 
+    incr val
+} {12}
+
 # cleanup
 ::tcltest::cleanupTests
 return