Tcl Source Code

Please ignore my last comment.

Since this patch is closed and it belongs to tk,
I have submitted a new patch (#103327) there.

Peter

Sorry, I have overlooked something in my last patch:
the invariant of the old behaviour was, that every 
MMRep had a valid string representation, therefor 
updateStringProc was not needed. This is with my
patch not the case any more. You can test this with

> tclsh8.4
load libtk8.4.so
canvas .c
pack .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
puts "qqq: $qx"

result is:
UpdateStringProc should not be invoked for type mm
Aborted

Therefor we need the updateStringProc. Here is the new
patch. It is against the original tk8.4a2 source.

Peter


*** generic/tkObj.orig.c Tue Nov 7 20:35:43 2000
--- generic/tkObj.c Thu Jan 4 12:46:22 2001
***************
*** 60,65 ****
--- 60,66 ----

static void DupMMInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
Tcl_Obj *copyPtr));
+ static void UpdateStringOfMM _ANSI_ARGS_((Tcl_Obj *objPtr));
static void DupPixelInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
Tcl_Obj *copyPtr));
static void FreeMMInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr));
***************
*** 95,101 ****
"mm", /* name */
FreeMMInternalRep, /* freeIntRepProc */
DupMMInternalRep, /* dupIntRepProc */
! NULL, /* updateStringProc */
SetMMFromAny /* setFromAnyProc */
};

--- 96,102 ----
"mm", /* name */
FreeMMInternalRep, /* freeIntRepProc */
DupMMInternalRep, /* dupIntRepProc */
! UpdateStringOfMM, /* updateStringProc */
SetMMFromAny /* setFromAnyProc */
};

***************
*** 473,478 ****
--- 474,521 ----
/*
*----------------------------------------------------------------------
*
+ * 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,548 ****
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. 
*/
--- 544,597 ----
int units;
MMRep *mmPtr;

! if( objPtr->typePtr == &tclDoubleType ) {
! /* optimize for speed reasons */
! Tcl_GetDoubleFromObj( interp, objPtr, &d );
! units = -1;
! } else {
! 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. 
*/

Unfortunately, while bugs can be transferred, it appears that patches cannot be (system feature oversight).  I considered the use of Tcl_GetObjType, however if you look at the full code of the function that the patch edits (as I did in patching), you'll see that it grossly manipulates the internal structure already.  That's why I noted a later cleanup over the whole core (new APIs needed) would be appropriate.

This is a Tk patch, not Tcl.  Can it be moved to
the Tk Toolkit group?

The patch includes direct access to &tclDoubleType.
Wouldn't it be better to use Tcl_GetObjType("double")
so Tk uses public rather than private interfaces?

Sorry I didn't catch that before commit.

Commited 13 Dec 2000.

Reading the patch I think that Tk could make good use of a "ScreenDistance" ObjType
containing both value and unit. This comment is no objection against the patch, just
something to think about for the future. I'll make that an explicit tk feature request soon.
I would give this patch a go-ahead.

Oh, and someone please move this patch into the Tk area where it belongs (I can't).

This uses the direct object type references, which exposes some icky guts.  Eventually we need to make some pretty macros or APIs to cover those up, but since they aren't yet available, we should add this in now and correct it when we clean up all the other similar uses of object type equality checks.