diff options
Diffstat (limited to 'generic/tclUtil.c')
| -rw-r--r-- | generic/tclUtil.c | 106 |
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 |