summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tclBasic.c21
-rw-r--r--generic/tclInt.h10
-rw-r--r--generic/tclStringObj.c85
3 files changed, 61 insertions, 55 deletions
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 --
generated by cgit v0.12 at 2024-12-26 16:03:09 (GMT)