diff options
author | andreas_kupries <akupries@shaw.ca> | 2006-11-28 22:19:57 (GMT) |
---|---|---|
committer | andreas_kupries <akupries@shaw.ca> | 2006-11-28 22:19:57 (GMT) |
commit | bf08959966d3a565773dbddb52b0be2e0747ec3a (patch) | |
tree | dfdbbd337f6bf772d6f99a7a6ea50aaaab685d00 /generic/tclCmdAH.c | |
parent | 78afab8ec5cb163b94f8fed86fb67d9e339d9268 (diff) | |
download | tcl-bf08959966d3a565773dbddb52b0be2e0747ec3a.zip tcl-bf08959966d3a565773dbddb52b0be2e0747ec3a.tar.gz tcl-bf08959966d3a565773dbddb52b0be2e0747ec3a.tar.bz2 |
* generic/tclBasic.c: TIP #280 implementation, conditional on the define TCL_TIP280.
* generic/tclCmdAH.c:
* generic/tclCmdIL.c:
* generic/tclCmdMZ.c:
* generic/tclCompCmds.c:
* generic/tclCompExpr.c:
* generic/tclCompile.c:
* generic/tclCompile.h:
* generic/tclExecute.c:
* generic/tclIOUtil.c:
* generic/tclInt.h:
* generic/tclInterp.c:
* generic/tclNamesp.c:
* generic/tclObj.c:
* generic/tclProc.c:
* tests/compile.test:
* tests/info.test:
* tests/platform.test:
* tests/safe.test:
Diffstat (limited to 'generic/tclCmdAH.c')
-rw-r--r-- | generic/tclCmdAH.c | 59 |
1 files changed, 58 insertions, 1 deletions
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index c3402ef..6621714 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCmdAH.c,v 1.27.2.15 2005/10/23 22:01:29 msofer Exp $ + * RCS: @(#) $Id: tclCmdAH.c,v 1.27.2.16 2006/11/28 22:20:00 andreas_kupries Exp $ */ #include "tclInt.h" @@ -235,6 +235,9 @@ Tcl_CatchObjCmd(dummy, interp, objc, objv) { Tcl_Obj *varNamePtr = NULL; int result; +#ifdef TCL_TIP280 + Interp* iPtr = (Interp*) interp; +#endif if ((objc != 2) && (objc != 3)) { Tcl_WrongNumArgs(interp, 1, objv, "command ?varName?"); @@ -245,7 +248,12 @@ Tcl_CatchObjCmd(dummy, interp, objc, objv) varNamePtr = objv[2]; } +#ifndef TCL_TIP280 result = Tcl_EvalObjEx(interp, objv[1], 0); +#else + /* TIP #280. Make invoking context available to caught script */ + result = TclEvalObjEx(interp, objv[1], 0, iPtr->cmdFramePtr,1); +#endif if (objc == 3) { if (Tcl_ObjSetVar2(interp, varNamePtr, NULL, @@ -592,6 +600,9 @@ Tcl_EvalObjCmd(dummy, interp, objc, objv) { int result; register Tcl_Obj *objPtr; +#ifdef TCL_TIP280 + Interp* iPtr = (Interp*) interp; +#endif if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "arg ?arg ...?"); @@ -599,7 +610,13 @@ Tcl_EvalObjCmd(dummy, interp, objc, objv) } if (objc == 2) { +#ifndef TCL_TIP280 result = Tcl_EvalObjEx(interp, objv[1], TCL_EVAL_DIRECT); +#else + /* TIP #280. Make invoking context available to eval'd script */ + result = TclEvalObjEx(interp, objv[1], TCL_EVAL_DIRECT, + iPtr->cmdFramePtr,1); +#endif } else { /* * More than one argument: concatenate them together with spaces @@ -607,7 +624,12 @@ Tcl_EvalObjCmd(dummy, interp, objc, objv) * the object when it decrements its refcount after eval'ing it. */ objPtr = Tcl_ConcatObj(objc-1, objv+1); +#ifndef TCL_TIP280 result = Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_DIRECT); +#else + /* TIP #280. Make invoking context available to eval'd script */ + result = TclEvalObjEx(interp, objPtr, TCL_EVAL_DIRECT, NULL, 0); +#endif } if (result == TCL_ERROR) { char msg[32 + TCL_INTEGER_SPACE]; @@ -1607,13 +1629,21 @@ Tcl_ForObjCmd(dummy, interp, objc, objv) Tcl_Obj *CONST objv[]; /* Argument objects. */ { int result, value; +#ifdef TCL_TIP280 + Interp* iPtr = (Interp*) interp; +#endif if (objc != 5) { Tcl_WrongNumArgs(interp, 1, objv, "start test next command"); return TCL_ERROR; } +#ifndef TCL_TIP280 result = Tcl_EvalObjEx(interp, objv[1], 0); +#else + /* TIP #280. Make invoking context available to initial script */ + result = TclEvalObjEx(interp, objv[1], 0, iPtr->cmdFramePtr,1); +#endif if (result != TCL_OK) { if (result == TCL_ERROR) { Tcl_AddErrorInfo(interp, "\n (\"for\" initial command)"); @@ -1635,7 +1665,12 @@ Tcl_ForObjCmd(dummy, interp, objc, objv) if (!value) { break; } +#ifndef TCL_TIP280 result = Tcl_EvalObjEx(interp, objv[4], 0); +#else + /* TIP #280. Make invoking context available to loop body */ + result = TclEvalObjEx(interp, objv[4], 0, iPtr->cmdFramePtr,4); +#endif if ((result != TCL_OK) && (result != TCL_CONTINUE)) { if (result == TCL_ERROR) { char msg[32 + TCL_INTEGER_SPACE]; @@ -1645,7 +1680,12 @@ Tcl_ForObjCmd(dummy, interp, objc, objv) } break; } +#ifndef TCL_TIP280 result = Tcl_EvalObjEx(interp, objv[3], 0); +#else + /* TIP #280. Make invoking context available to next script */ + result = TclEvalObjEx(interp, objv[3], 0, iPtr->cmdFramePtr,3); +#endif if (result == TCL_BREAK) { break; } else if (result != TCL_OK) { @@ -1719,6 +1759,9 @@ Tcl_ForeachObjCmd(dummy, interp, objc, objv) Tcl_Obj ***varvList = varvListArray; /* Array of var name lists */ int *argcList = argcListArray; /* Array of value list sizes */ Tcl_Obj ***argvList = argvListArray; /* Array of value lists */ +#ifdef TCL_TIP280 + Interp* iPtr = (Interp*) interp; +#endif if (objc < 4 || (objc%2 != 0)) { Tcl_WrongNumArgs(interp, 1, objv, @@ -1848,7 +1891,12 @@ Tcl_ForeachObjCmd(dummy, interp, objc, objv) } } +#ifndef TCL_TIP280 result = Tcl_EvalObjEx(interp, bodyPtr, 0); +#else + /* TIP #280. Make invoking context available to loop body */ + result = TclEvalObjEx(interp, bodyPtr, 0, iPtr->cmdFramePtr,objc-1); +#endif if (result != TCL_OK) { if (result == TCL_CONTINUE) { result = TCL_OK; @@ -2394,3 +2442,12 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv) Tcl_DecrRefCount(resultPtr); return TCL_ERROR; } + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ + |