* generic/tclBasic.c: First caller of TclFormatToErrorInfo.

        * generic/tclInt.h:             Using stdarg.h conventions, add more
        * generic/tclStringObj.c:       fixed arguments to TclFormatObj() and
        TclObjPrintf().  Added new routine TclFormatToErrorInfo().

4 files changed, 67 insertions, 55 deletions

diff --git a/ChangeLog b/ChangeLog
index e4edf8b..7ca05b0 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,11 @@
 2005-09-13  Don Porter  <dgp@users.sourceforge.net>
 
+	* generic/tclBasic.c:	First caller of TclFormatToErrorInfo.
+
+	* generic/tclInt.h:		Using stdarg.h conventions, add more
+	* generic/tclStringObj.c:	fixed arguments to TclFormatObj() and
+	TclObjPrintf().  Added new routine TclFormatToErrorInfo().
+
 	* generic/tcl.h:	Explicitly standardized on the use of stdarg.h
 	* generic/tclBasic.c:	conventions for functions with variable number
 	* generic/tclInt.h:	of arguments.  Support for varargs.h has been
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 7266c08..a038550 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -13,7 +13,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclBasic.c,v 1.170 2005/09/13 21:23:51 dgp Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.171 2005/09/14 03:46:50 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -3769,22 +3769,9 @@ Tcl_EvalEx(interp, script, numBytes, flags)
 		    code = Tcl_ListObjLength(interp,
 			    objv[objectsUsed], &numElements);
 		    if (code == TCL_ERROR) {
-			/*
-			 * Attempt to expand a non-list.
-			 */
-
-			Tcl_Obj *msg;
-			Tcl_Obj *wordNum;
-
-			msg = Tcl_NewStringObj("\n    (expanding word ", -1);
-			TclNewIntObj(wordNum, objectsUsed);
-			Tcl_IncrRefCount(wordNum);
-			Tcl_IncrRefCount(msg);
-			Tcl_AppendObjToObj(msg, wordNum);
-			Tcl_DecrRefCount(wordNum);
-			Tcl_AppendToObj(msg, ")", -1);
-			TclAppendObjToErrorInfo(interp, msg);
-			Tcl_DecrRefCount(msg);
+			/* Attempt to expand a non-list. */
+			TclFormatToErrorInfo(interp,
+				"\n    (expanding word %d)", objectsUsed);
 			Tcl_DecrRefCount(objv[objectsUsed]);
 			goto error;
 		    }
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 43d12c7..b810845 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -12,7 +12,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclInt.h,v 1.251 2005/09/13 21:23:51 dgp Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.252 2005/09/14 03:46:50 dgp Exp $
  */
 
 #ifndef _TCLINT
@@ -2001,7 +2001,10 @@ MODULE_SCOPE void	TclFinalizePreserve(void);
 MODULE_SCOPE void	TclFinalizeSynchronization(void);
 MODULE_SCOPE void	TclFinalizeThreadData(void);
 MODULE_SCOPE void	TclFormatNaN(double value, char* buffer);
-MODULE_SCOPE int	TclFormatObj(Tcl_Interp *arg1, ...);
+MODULE_SCOPE int	TclFormatObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
+			    CONST char *format, ...);
+MODULE_SCOPE int	TclFormatToErrorInfo(Tcl_Interp *interp,
+			    CONST char *format, ...);
 MODULE_SCOPE int	TclFSFileAttrIndex(Tcl_Obj *pathPtr,
 			    CONST char *attributeName, int *indexPtr);
 MODULE_SCOPE Tcl_Obj *	TclGetBgErrorHandler(Tcl_Interp *interp);
@@ -2053,7 +2056,8 @@ MODULE_SCOPE int	TclMergeReturnOptions(Tcl_Interp *interp, int objc,
 MODULE_SCOPE int	TclObjInvokeNamespace(Tcl_Interp *interp,
 			    int objc, Tcl_Obj *CONST objv[],
 			    Tcl_Namespace *nsPtr, int flags);
-MODULE_SCOPE int	TclObjPrintf(Tcl_Interp *arg1, ...);
+MODULE_SCOPE int	TclObjPrintf(Tcl_Interp *interp, Tcl_Obj *objPtr,
+			    CONST char *format, ...);
 MODULE_SCOPE int	TclParseBackslash(CONST char *src,
 			    int numBytes, int *readPtr, char *dst);
 MODULE_SCOPE int	TclParseHex(CONST char *src, int numBytes,
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index 0b2cdb2..802e94a 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.44 2005/09/13 21:23:51 dgp Exp $ */
+ * RCS: @(#) $Id: tclStringObj.c,v 1.45 2005/09/14 03:46:50 dgp Exp $ */
 
 #include "tclInt.h"
 
@@ -53,8 +53,10 @@ static void		AppendUtfToUtfRep _ANSI_ARGS_((Tcl_Obj *objPtr,
 			    CONST char *bytes, int numBytes));
 static void		FillUnicodeRep _ANSI_ARGS_((Tcl_Obj *objPtr));
 static int		FormatObjVA _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *objPtr, CONST char *format,
 			    va_list argList));
 static int		ObjPrintfVA _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *objPtr, CONST char *format,
 			    va_list argList));
 static void		FreeStringInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr));
 static void		DupStringInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr,
@@ -2214,23 +2216,13 @@ TclAppendFormattedObjs(interp, baseObj, format, objc, objv)
  */
 
 static int
-FormatObjVA(interp, argList)
-    Tcl_Interp *interp;
-    va_list argList;
+FormatObjVA(Tcl_Interp *interp,
+    Tcl_Obj *objPtr,
+    CONST char *format,
+    va_list argList)
 {
     int code, objc;
     Tcl_Obj **objv, *element, *list = Tcl_NewObj();
-    CONST char *format;
-    Tcl_Obj *objPtr = va_arg(argList, Tcl_Obj *);
-
-    if (objPtr == NULL) {
-	Tcl_Panic("TclFormatObj: no Tcl_Obj to append to");
-    }
-
-    format = va_arg(argList, CONST char *);
-    if (format == NULL) {
-	Tcl_Panic("TclFormatObj: no format string argument");
-    }
 
     Tcl_IncrRefCount(list);
     element = va_arg(argList, Tcl_Obj *);
@@ -2259,13 +2251,13 @@ FormatObjVA(interp, argList)
  */
 
 int
-TclFormatObj(Tcl_Interp *interp, ...)
+TclFormatObj(Tcl_Interp *interp, Tcl_Obj *objPtr, CONST char *format, ...)
 {
     va_list argList;
     int result;
 
-    va_start(argList, interp);
-    result = FormatObjVA(interp, argList);
+    va_start(argList, format);
+    result = FormatObjVA(interp, objPtr, format, argList);
     va_end(argList);
     return result;
 }
@@ -2283,24 +2275,17 @@ TclFormatObj(Tcl_Interp *interp, ...)
  */
 
 static int
-ObjPrintfVA(interp, argList)
-    Tcl_Interp *interp;
-    va_list argList;
+ObjPrintfVA(
+    Tcl_Interp *interp,
+    Tcl_Obj *objPtr,
+    CONST char *format,
+    va_list argList)
 {
     int code, objc;
     Tcl_Obj **objv, *list = Tcl_NewObj();
-    CONST char *format, *p;
-    Tcl_Obj *objPtr = va_arg(argList, Tcl_Obj *);
-
-    if (objPtr == NULL) {
-	Tcl_Panic("TclObjPrintf: no Tcl_Obj to append to");
-    }
-
-    p = format = va_arg(argList, CONST char *);
-    if (format == NULL) {
-	Tcl_Panic("TclObjPrintf: no format string argument");
-    }
+    CONST char *p;
 
+    p = format;
     Tcl_IncrRefCount(list);
     while (*p != '\0') {
 	int size = 0;
@@ -2384,18 +2369,48 @@ ObjPrintfVA(interp, argList)
  */
 
 int
-TclObjPrintf(Tcl_Interp *interp, ...)
+TclObjPrintf(Tcl_Interp *interp, Tcl_Obj *objPtr, CONST char *format, ...)
 {
     va_list argList;
     int result;
 
-    va_start(argList, interp);
-    result = ObjPrintfVA(interp, argList);
+    va_start(argList, format);
+    result = ObjPrintfVA(interp, objPtr, format, argList);
     va_end(argList);
     return result;
 }
 
 /*
+ *----------------------------------------------------------------------
+ *
+ * TclFormatToErrorInfo --
+ *
+ * Results:
+ *
+ * Side effects:
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclFormatToErrorInfo(Tcl_Interp *interp, CONST char *format, ...)
+{
+    int code;
+    va_list argList;
+    Tcl_Obj *objPtr = Tcl_NewObj();
+
+    va_start(argList, format);
+    code = ObjPrintfVA(interp, objPtr, format, argList);
+    va_end(argList);
+    if (code != TCL_OK) {
+        return code;
+    }
+    TclAppendObjToErrorInfo(interp, objPtr);
+    Tcl_DecrRefCount(objPtr);
+    return TCL_OK;
+}
+
+/*
  *---------------------------------------------------------------------------
  *
  * FillUnicodeRep --