diff options
Diffstat (limited to 'generic/tclCmdMZ.c')
| -rw-r--r-- | generic/tclCmdMZ.c | 155 |
1 files changed, 1 insertions, 154 deletions
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 2ae4819..4e70522 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -14,7 +14,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCmdMZ.c,v 1.82 2003/02/27 00:54:36 hobbs Exp $ + * RCS: @(#) $Id: tclCmdMZ.c,v 1.83 2003/03/13 02:48:52 dgp Exp $ */ #include "tclInt.h" @@ -2490,159 +2490,6 @@ Tcl_SubstObjCmd(dummy, interp, objc, objv) /* *---------------------------------------------------------------------- * - * Tcl_SubstObj -- - * - * This function performs the substitutions specified on the - * given string as described in the user documentation for the - * "subst" Tcl command. This code is heavily based on an - * implementation by Andrew Payne. Note that if a command - * substitution returns TCL_CONTINUE or TCL_RETURN from its - * evaluation and is not completely well-formed, the results are - * not defined (or at least hard to characterise.) This fault - * will be fixed at some point, but the cost of the only sane - * fix (well-formedness check first) is such that you need to - * "precompile and cache" to stop everyone from being hit with - * the consequences every time through. Note that the current - * behaviour is not a security hole; it just restarts parsing - * the string following the substitution in a mildly surprising - * place, and it is a very bad idea to count on this remaining - * the same in future... - * - * Results: - * A Tcl_Obj* containing the substituted string, or NULL to - * indicate that an error occurred. - * - * Side effects: - * See the user documentation. - * - *---------------------------------------------------------------------- - */ - -Tcl_Obj * -Tcl_SubstObj(interp, objPtr, flags) - Tcl_Interp *interp; - Tcl_Obj *objPtr; - int flags; -{ - Tcl_Obj *resultObj; - char *p, *old; - - old = p = Tcl_GetString(objPtr); - resultObj = Tcl_NewStringObj("", 0); - while (1) { - switch (*p) { - case 0: - if (p != old) { - Tcl_AppendToObj(resultObj, old, p-old); - } - return resultObj; - - case '\\': - if (flags & TCL_SUBST_BACKSLASHES) { - char buf[TCL_UTF_MAX]; - int count; - - if (p != old) { - Tcl_AppendToObj(resultObj, old, p-old); - } - Tcl_AppendToObj(resultObj, buf, - Tcl_UtfBackslash(p, &count, buf)); - p += count; - old = p; - } else { - p++; - } - break; - - case '$': - if (flags & TCL_SUBST_VARIABLES) { - Tcl_Parse parse; - int code; - - /* - * Code is simpler overall if we (effectively) inline - * Tcl_ParseVar, particularly as that allows us to use - * a non-string interface when we come to appending - * the variable contents to the result object. There - * are a few other optimisations that doing this - * enables (like being able to continue the run of - * unsubstituted characters straight through if a '$' - * does not precede a variable name.) - */ - if (Tcl_ParseVarName(interp, p, -1, &parse, 0) != TCL_OK) { - goto errorResult; - } - if (parse.numTokens == 1) { - /* - * There isn't a variable name after all: the $ is - * just a $. - */ - p++; - break; - } - if (p != old) { - Tcl_AppendToObj(resultObj, old, p-old); - } - p += parse.tokenPtr->size; - code = Tcl_EvalTokensStandard(interp, parse.tokenPtr, - parse.numTokens); - if (code == TCL_ERROR) { - goto errorResult; - } - if (code == TCL_BREAK) { - Tcl_ResetResult(interp); - return resultObj; - } - if (code != TCL_CONTINUE) { - Tcl_AppendObjToObj(resultObj, Tcl_GetObjResult(interp)); - } - Tcl_ResetResult(interp); - old = p; - } else { - p++; - } - break; - - case '[': - if (flags & TCL_SUBST_COMMANDS) { - Interp *iPtr = (Interp *) interp; - int code; - - if (p != old) { - Tcl_AppendToObj(resultObj, old, p-old); - } - iPtr->evalFlags = TCL_BRACKET_TERM; - code = Tcl_EvalEx(interp, p+1, -1, 0); - switch (code) { - case TCL_ERROR: - goto errorResult; - case TCL_BREAK: - Tcl_ResetResult(interp); - return resultObj; - default: - Tcl_AppendObjToObj(resultObj, Tcl_GetObjResult(interp)); - case TCL_CONTINUE: - Tcl_ResetResult(interp); - old = p = (p+1 + iPtr->termOffset + 1); - } - } else { - p++; - } - break; - default: - p++; - break; - } - } - - errorResult: - Tcl_DecrRefCount(resultObj); - return NULL; -} - -/* - *---------------------------------------------------------------------- - * * Tcl_SwitchObjCmd -- * * This object-based procedure is invoked to process the "switch" Tcl |