summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorhobbs <hobbs>2001-03-30 07:11:44 (GMT)
committerhobbs <hobbs>2001-03-30 07:11:44 (GMT)
commit8df8dbf9d21ffe245619e3da00b552c7401b4f93 (patch)
treeee162b0f9bbc9f255a8206147eac23a3ef91f573
parentfe669ce208870caf72df127b1cca6f16d5bc1b4a (diff)
downloadtk-8df8dbf9d21ffe245619e3da00b552c7401b4f93.zip
tk-8df8dbf9d21ffe245619e3da00b552c7401b4f93.tar.gz
tk-8df8dbf9d21ffe245619e3da00b552c7401b4f93.tar.bz2
* tests/canvas.test: added test case to check obj conversion
* generic/tkObj.c (UpdateStringOfMM, SetMMFromAny): better obj-aware screen distances. (pgbaum, hobbs) [Patch #403327]
-rw-r--r--ChangeLog21
-rw-r--r--generic/tkObj.c78
-rw-r--r--tests/canvas.test22
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