diff options
| -rw-r--r-- | ChangeLog | 21 | ||||
| -rw-r--r-- | generic/tkObj.c | 78 | ||||
| -rw-r--r-- | tests/canvas.test | 22 |
3 files changed, 116 insertions, 5 deletions
@@ -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 |