diff options
Diffstat (limited to 'generic/tclCmdIL.c')
| -rw-r--r-- | generic/tclCmdIL.c | 57 |
1 files changed, 56 insertions, 1 deletions
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 03f5593..9c89ae4 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -16,7 +16,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.171 2009/08/20 10:56:55 dkf Exp $ + * RCS: @(#) $Id: tclCmdIL.c,v 1.172 2009/11/16 17:38:08 ferrieux Exp $ */ #include "tclInt.h" @@ -118,6 +118,9 @@ static int InfoCompleteCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int InfoDefaultCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); +/* TIP #348 - New 'info' subcommand 'errorstack' */ +static int InfoErrorStackCmd(ClientData dummy, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]); /* TIP #280 - New 'info' subcommand 'frame' */ static int InfoFrameCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); @@ -164,6 +167,7 @@ static const EnsembleImplMap defaultInfoMap[] = { {"complete", InfoCompleteCmd, NULL}, {"coroutine", TclInfoCoroutineCmd, NULL}, {"default", InfoDefaultCmd, NULL}, + {"errorstack", InfoErrorStackCmd, NULL}, {"exists", TclInfoExistsCmd, TclCompileInfoExistsCmd}, {"frame", InfoFrameCmd, NULL}, {"functions", InfoFunctionsCmd, NULL}, @@ -1017,6 +1021,55 @@ InfoDefaultCmd( /* *---------------------------------------------------------------------- * + * InfoErrorStackCmd -- + * + * Called to implement the "info errorstack" command that returns information + * about the last error's call stack. Handles the following syntax: + * + * info errorstack ?interp? + * + * 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. + * + *---------------------------------------------------------------------- + */ + +static int +InfoErrorStackCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + Tcl_Interp *target; + Interp *iPtr; + + if ((objc != 1) && (objc != 2)) { + Tcl_WrongNumArgs(interp, 1, objv, "?interp?"); + return TCL_ERROR; + } + + target = interp; + if (objc == 2) { + target = Tcl_GetSlave(interp, Tcl_GetString(objv[1])); + if (target == NULL) { + return TCL_ERROR; + } + } + + iPtr = (Interp *) target; + Tcl_SetObjResult(interp, iPtr->errorStack); + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * * TclInfoExistsCmd -- * * Called to implement the "info exists" command that determines whether @@ -4388,5 +4441,7 @@ SelectObjFromSublist( * mode: c * c-basic-offset: 4 * fill-column: 78 + * tab-width: 8 + * indent-tabs-mode: nil * End: */ |