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 d063014..bdc6d2e 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.180 2010/03/05 14:34:03 dkf Exp $ + * RCS: @(#) $Id: tclCmdIL.c,v 1.181 2010/04/05 19:44:45 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, NULL, NULL}, {"coroutine", TclInfoCoroutineCmd, NULL, NULL, NULL}, {"default", InfoDefaultCmd, NULL, NULL, NULL}, + {"errorstack", InfoErrorStackCmd, NULL, NULL, NULL}, {"exists", TclInfoExistsCmd, TclCompileInfoExistsCmd, NULL, NULL}, {"frame", InfoFrameCmd, NULL, NULL, NULL}, {"functions", InfoFunctionsCmd, NULL, NULL, NULL}, @@ -1022,6 +1026,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 @@ -4401,5 +4454,7 @@ SelectObjFromSublist( * mode: c * c-basic-offset: 4 * fill-column: 78 + * tab-width: 8 + * indent-tabs-mode: nil * End: */ |