summaryrefslogtreecommitdiffstats
path: root/generic/tclUtil.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclUtil.c')
-rw-r--r--generic/tclUtil.c106
1 files changed, 88 insertions, 18 deletions
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index bdbac1c..c02c700 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclUtil.c,v 1.3 1998/09/14 18:40:02 stanton Exp $
+ * RCS: @(#) $Id: tclUtil.c,v 1.4 1999/03/10 05:52:50 stanton Exp $
*/
#include "tclInt.h"
@@ -1409,7 +1409,7 @@ Tcl_GetObjResult(interp)
/*
*----------------------------------------------------------------------
*
- * Tcl_AppendResult --
+ * Tcl_AppendResultVA --
*
* Append a variable number of strings onto the interpreter's string
* result.
@@ -1419,8 +1419,8 @@ Tcl_GetObjResult(interp)
*
* Side effects:
* The result of the interpreter given by the first argument is
- * extended by the strings given by the second and following arguments
- * (up to a terminating NULL argument).
+ * extended by the strings in the va_list (up to a terminating NULL
+ * argument).
*
* If the string result is empty, the object result is moved to the
* string result, then the object result is reset.
@@ -1429,10 +1429,13 @@ Tcl_GetObjResult(interp)
*/
void
-Tcl_AppendResult TCL_VARARGS_DEF(Tcl_Interp *,arg1)
+Tcl_AppendResultVA (interp, argList)
+ Tcl_Interp *interp; /* Interpreter with which to associate the
+ * return value. */
+ va_list argList; /* Variable argument list. */
{
- va_list argList;
- Interp *iPtr;
+ Interp *iPtr = (Interp *) interp;
+ va_list tmpArgList;
char *string;
int newSpace;
@@ -1442,7 +1445,6 @@ Tcl_AppendResult TCL_VARARGS_DEF(Tcl_Interp *,arg1)
* FAILS IF OBJECT RESULT'S STRING REPRESENTATION CONTAINS NULLS.
*/
- iPtr = (Interp *) TCL_VARARGS_START(Tcl_Interp *,arg1,argList);
if (*(iPtr->result) == 0) {
Tcl_SetResult((Tcl_Interp *) iPtr,
TclGetStringFromObj(Tcl_GetObjResult((Tcl_Interp *) iPtr),
@@ -1454,15 +1456,15 @@ Tcl_AppendResult TCL_VARARGS_DEF(Tcl_Interp *,arg1)
* Scan through all the arguments to see how much space is needed.
*/
+ tmpArgList = argList;
newSpace = 0;
while (1) {
- string = va_arg(argList, char *);
+ string = va_arg(tmpArgList, char *);
if (string == NULL) {
break;
}
newSpace += strlen(string);
}
- va_end(argList);
/*
* If the append buffer isn't already setup and large enough to hold
@@ -1480,7 +1482,6 @@ Tcl_AppendResult TCL_VARARGS_DEF(Tcl_Interp *,arg1)
* buffer.
*/
- TCL_VARARGS_START(Tcl_Interp *,arg1,argList);
while (1) {
string = va_arg(argList, char *);
if (string == NULL) {
@@ -1489,6 +1490,38 @@ Tcl_AppendResult TCL_VARARGS_DEF(Tcl_Interp *,arg1)
strcpy(iPtr->appendResult + iPtr->appendUsed, string);
iPtr->appendUsed += strlen(string);
}
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AppendResult --
+ *
+ * Append a variable number of strings onto the interpreter's string
+ * result.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The result of the interpreter given by the first argument is
+ * extended by the strings given by the second and following arguments
+ * (up to a terminating NULL argument).
+ *
+ * If the string result is empty, the object result is moved to the
+ * string result, then the object result is reset.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_AppendResult TCL_VARARGS_DEF(Tcl_Interp *,arg1)
+{
+ Tcl_Interp *interp;
+ va_list argList;
+
+ interp = TCL_VARARGS_START(Tcl_Interp *,arg1,argList);
+ Tcl_AppendResultVA(interp, argList);
va_end(argList);
}
@@ -1724,7 +1757,7 @@ Tcl_ResetResult(interp)
/*
*----------------------------------------------------------------------
*
- * Tcl_SetErrorCode --
+ * Tcl_SetErrorCodeVA --
*
* This procedure is called to record machine-readable information
* about an error that is about to be returned.
@@ -1741,21 +1774,22 @@ Tcl_ResetResult(interp)
*
*----------------------------------------------------------------------
*/
- /* VARARGS2 */
+
void
-Tcl_SetErrorCode TCL_VARARGS_DEF(Tcl_Interp *,arg1)
+Tcl_SetErrorCodeVA (interp, argList)
+ Tcl_Interp *interp; /* Interpreter in which to access the errorCode
+ * variable. */
+ va_list argList; /* Variable argument list. */
{
- va_list argList;
char *string;
int flags;
- Interp *iPtr;
+ Interp *iPtr = (Interp *) interp;
/*
* Scan through the arguments one at a time, appending them to
* $errorCode as list elements.
*/
- iPtr = (Interp *) TCL_VARARGS_START(Tcl_Interp *,arg1,argList);
flags = TCL_GLOBAL_ONLY | TCL_LIST_ELEMENT;
while (1) {
string = va_arg(argList, char *);
@@ -1766,13 +1800,49 @@ Tcl_SetErrorCode TCL_VARARGS_DEF(Tcl_Interp *,arg1)
(char *) NULL, string, flags);
flags |= TCL_APPEND_VALUE;
}
- va_end(argList);
iPtr->flags |= ERROR_CODE_SET;
}
/*
*----------------------------------------------------------------------
*
+ * Tcl_SetErrorCode --
+ *
+ * This procedure is called to record machine-readable information
+ * about an error that is about to be returned.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The errorCode global variable is modified to hold all of the
+ * arguments to this procedure, in a list form with each argument
+ * becoming one element of the list. A flag is set internally
+ * to remember that errorCode has been set, so the variable doesn't
+ * get set automatically when the error is returned.
+ *
+ *----------------------------------------------------------------------
+ */
+ /* VARARGS2 */
+void
+Tcl_SetErrorCode TCL_VARARGS_DEF(Tcl_Interp *,arg1)
+{
+ Tcl_Interp *interp;
+ va_list argList;
+
+ /*
+ * Scan through the arguments one at a time, appending them to
+ * $errorCode as list elements.
+ */
+
+ interp = TCL_VARARGS_START(Tcl_Interp *,arg1,argList);
+ Tcl_SetErrorCodeVA(interp, argList);
+ va_end(argList);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_SetObjErrorCode --
*
* This procedure is called to record machine-readable information