diff options
Diffstat (limited to 'generic')
| -rw-r--r-- | generic/tclCmdIL.c | 23 | ||||
| -rw-r--r-- | generic/tclIOUtil.c | 6 |
2 files changed, 22 insertions, 7 deletions
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index d9a29b6..5135476 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.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: tclCmdIL.c,v 1.26 2000/05/09 17:50:38 ericm Exp $ + * RCS: @(#) $Id: tclCmdIL.c,v 1.27 2000/05/27 23:58:01 hobbs Exp $ */ #include "tclInt.h" @@ -1578,14 +1578,17 @@ InfoProcsCmd(dummy, interp, objc, objv) * script file that is currently being evaluated. Handles the * following syntax: * - * info script + * info script ?newName? + * + * If newName is specified, it will set that as the internal name. * * Results: * Returns TCL_OK if successful and TCL_ERROR if there is an error. * * Side effects: * Returns a result in the interpreter's result object. If there is - * an error, the result is an error message. + * an error, the result is an error message. It may change the + * internal script filename. * *---------------------------------------------------------------------- */ @@ -1598,11 +1601,21 @@ InfoScriptCmd(dummy, interp, objc, objv) Tcl_Obj *CONST objv[]; /* Argument objects. */ { Interp *iPtr = (Interp *) interp; - if (objc != 2) { - Tcl_WrongNumArgs(interp, 2, objv, NULL); + if ((objc != 2) && (objc != 3)) { + Tcl_WrongNumArgs(interp, 2, objv, "?filename?"); return TCL_ERROR; } + if (objc == 3) { + int length; + char *filename = Tcl_GetStringFromObj(objv[2], &length); + + if (iPtr->scriptFile != NULL) { + ckfree(iPtr->scriptFile); + } + iPtr->scriptFile = ckalloc((unsigned) (length + 1)); + strcpy(iPtr->scriptFile, filename); + } if (iPtr->scriptFile != NULL) { Tcl_SetStringObj(Tcl_GetObjResult(interp), iPtr->scriptFile, -1); } diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index 41db745..f4412e5 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.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: tclIOUtil.c,v 1.10 2000/05/11 00:16:53 hobbs Exp $ + * RCS: @(#) $Id: tclIOUtil.c,v 1.11 2000/05/27 23:58:01 hobbs Exp $ */ #include "tclInt.h" @@ -324,9 +324,11 @@ Tcl_EvalFile(interp, fileName) iPtr = (Interp *) interp; oldScriptFile = iPtr->scriptFile; - iPtr->scriptFile = fileName; + iPtr->scriptFile = ckalloc((unsigned) (strlen(fileName) + 1)); + strcpy(iPtr->scriptFile, fileName); string = Tcl_GetStringFromObj(objPtr, &length); result = Tcl_EvalEx(interp, string, length, 0); + ckfree(iPtr->scriptFile); iPtr->scriptFile = oldScriptFile; if (result == TCL_RETURN) { |