* generic/tclBasic.c (TclAppendObjToErrorInfo): New internal routine

        that appends a Tcl_Obj to the errorInfo, saving the caller the trouble
        of extracting the string rep.

        * generic/tclStringObj.c (TclAppendLimitedToObj):       New internal
        routine that supports truncated appends with optional ellipsis marking.
        This single routine supports UTF-8-safe truncated appends needed in
        several places throughout the Tcl source code, mostly for error and
        stack messages.  Clean fix for [Bug 760872].

        * generic/tclInt.h:     Declarations for new internal routines.

        * generic/tclCmdMZ.c:   Updated callers to use the new routines.
        * generic/tclCompExpr.c:
        * generic/tclCompile.c:
        * generic/tclExecute.c:
        * generic/tclIOUtil.c:
        * generic/tclNamesp.c:
        * generic/tclObj.c:
        * generic/tclParseExpr.c:
        * generic/tclProc.c:
        * generic/tclStringObj.c:
        * mac/tclMacResource.c:

        * library/init.tcl:     Updated ::errorInfo cleanup in [unknown] to
        reflect slight modifications to Tcl_LogCommandInfo().  Corrects
        failing init-4.* tests.

1 files changed, 67 insertions, 12 deletions

diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index 5925451..ed2dba7 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -33,7 +33,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclStringObj.c,v 1.32 2003/02/19 16:43:28 das Exp $ */
+ * RCS: @(#) $Id: tclStringObj.c,v 1.33 2003/10/14 15:44:53 dgp Exp $ */
 
 #include "tclInt.h"
 
@@ -991,9 +991,10 @@ Tcl_SetUnicodeObj(objPtr, unicode, numChars)
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_AppendToObj --
+ * TclAppendLimitedToObj --
  *
- *	This procedure appends a sequence of bytes to an object.
+ *	This procedure appends a limited number of bytes from a sequence
+ *	of bytes to an object, marking any limitation with an ellipsis.
  *
  * Results:
  *	None.
@@ -1006,20 +1007,26 @@ Tcl_SetUnicodeObj(objPtr, unicode, numChars)
  */
 
 void
-Tcl_AppendToObj(objPtr, bytes, length)
+TclAppendLimitedToObj(objPtr, bytes, length, limit, ellipsis)
     register Tcl_Obj *objPtr;	/* Points to the object to append to. */
     CONST char *bytes;		/* Points to the bytes to append to the
 				 * object. */
-    register int length;	/* The number of bytes to append from
-				 * "bytes". If < 0, then append all bytes
-				 * up to NULL byte. */
+    register int length;	/* The number of bytes available to be
+				 * appended from "bytes".  If < 0, then
+				 * all bytes up to a NULL byte are available. */
+    register int limit;		/* The maximum number of bytes to append
+				 * to the object. */
+    CONST char *ellipsis;	/* Ellipsis marker string, appended to
+				 * the object to indicate not all available
+				 * bytes at "bytes" were appended. */
 {
     String *stringPtr;
+    int toCopy = 0;
 
     if (Tcl_IsShared(objPtr)) {
-	panic("Tcl_AppendToObj called with shared object");
+	panic("TclAppendLimitedToObj called with shared object");
     }
-    
+
     SetStringFromAny(NULL, objPtr);
 
     if (length < 0) {
@@ -1029,6 +1036,15 @@ Tcl_AppendToObj(objPtr, bytes, length)
 	return;
     }
 
+    if (length <= limit) {
+	toCopy = length;
+    } else {
+	if (ellipsis == NULL) {
+	    ellipsis = "...";
+	}
+	toCopy = Tcl_UtfPrev(bytes+limit+1-strlen(ellipsis), bytes) - bytes;
+    }
+
     /*
      * If objPtr has a valid Unicode rep, then append the Unicode
      * conversion of "bytes" to the objPtr's Unicode rep, otherwise
@@ -1037,12 +1053,51 @@ Tcl_AppendToObj(objPtr, bytes, length)
 
     stringPtr = GET_STRING(objPtr);
     if (stringPtr->hasUnicode != 0) {
-	AppendUtfToUnicodeRep(objPtr, bytes, length);
+	AppendUtfToUnicodeRep(objPtr, bytes, toCopy);
+    } else {
+	AppendUtfToUtfRep(objPtr, bytes, toCopy);
+    }
 
-	stringPtr = GET_STRING(objPtr);
+    if (length <= limit) {
+	return;
+    }
+
+    stringPtr = GET_STRING(objPtr);
+    if (stringPtr->hasUnicode != 0) {
+	AppendUtfToUnicodeRep(objPtr, ellipsis, -1);
     } else {
-	AppendUtfToUtfRep(objPtr, bytes, length);
+	AppendUtfToUtfRep(objPtr, ellipsis, -1);
     }
+
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AppendToObj --
+ *
+ *	This procedure appends a sequence of bytes to an object.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The bytes at *bytes are appended to the string representation
+ *	of objPtr.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_AppendToObj(objPtr, bytes, length)
+    register Tcl_Obj *objPtr;	/* Points to the object to append to. */
+    CONST char *bytes;		/* Points to the bytes to append to the
+				 * object. */
+    register int length;	/* The number of bytes to append from
+				 * "bytes". If < 0, then append all bytes
+				 * up to NULL byte. */
+{
+    TclAppendLimitedToObj(objPtr, bytes, length, INT_MAX, NULL);
 }
 
 /*