Index: generic/tclCmdIL.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCmdIL.c,v
retrieving revision 1.86
diff -u -r1.86 tclCmdIL.c
--- generic/tclCmdIL.c	9 Dec 2005 14:13:00 -0000	1.86
+++ generic/tclCmdIL.c	9 Jun 2006 18:15:28 -0000
@@ -114,6 +114,8 @@
 			    int objc, Tcl_Obj *CONST objv[]);
 static int		InfoExistsCmd(ClientData dummy, Tcl_Interp *interp,
 			    int objc, Tcl_Obj *CONST objv[]);
+static int		InfoFrameCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *CONST objv[]);
 static int		InfoFunctionsCmd(ClientData dummy, Tcl_Interp *interp,
 			    int objc, Tcl_Obj *CONST objv[]);
 static int		InfoGlobalsCmd(ClientData dummy, Tcl_Interp *interp,
@@ -358,15 +360,15 @@
 {
     static CONST char *subCmds[] = {
 	    "args", "body", "cmdcount", "commands",
-	    "complete", "default", "exists", "functions", "globals",
-	    "hostname", "level", "library", "loaded",
+	    "complete", "default", "exists", "frame", "functions",
+	    "globals", "hostname", "level", "library", "loaded",
 	    "locals", "nameofexecutable", "patchlevel", "procs",
 	    "script", "sharedlibextension", "tclversion", "vars",
 	    (char *) NULL};
     enum ISubCmdIdx {
 	    IArgsIdx, IBodyIdx, ICmdCountIdx, ICommandsIdx,
-	    ICompleteIdx, IDefaultIdx, IExistsIdx, IFunctionsIdx, IGlobalsIdx,
-	    IHostnameIdx, ILevelIdx, ILibraryIdx, ILoadedIdx,
+	    ICompleteIdx, IDefaultIdx, IExistsIdx, IFrameIdx, IFunctionsIdx,
+	    IGlobalsIdx, IHostnameIdx, ILevelIdx, ILibraryIdx, ILoadedIdx,
 	    ILocalsIdx, INameOfExecutableIdx, IPatchLevelIdx, IProcsIdx,
 	    IScriptIdx, ISharedLibExtensionIdx, ITclVersionIdx, IVarsIdx
     };
@@ -405,6 +407,9 @@
 	case IExistsIdx:
 	    result = InfoExistsCmd(clientData, interp, objc, objv);
 	    break;
+	case IFrameIdx:
+	    result = InfoFrameCmd(clientData, interp, objc, objv);
+	    break;
 	case IFunctionsIdx:
 	    result = InfoFunctionsCmd(clientData, interp, objc, objv);
 	    break;
@@ -1073,6 +1078,72 @@
 /*
  *----------------------------------------------------------------------
  *
+ * InfoFrameCmd --
+ *
+ *	Called to implement the "info frame" command that returns information
+ *	about the stack of CallFrames. Handles the following syntax:
+ *
+ *	    info frame ?number?
+ *
+ * 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
+InfoFrameCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    Interp *iPtr = (Interp *) interp;
+    int level, currentLevel = 0;
+    CallFrame *framePtr = iPtr->framePtr;
+    Tcl_Obj *listPtr;
+
+    while (framePtr != NULL) {
+	currentLevel++;
+	framePtr = framePtr->callerPtr;
+    }
+
+    if (objc == 2) {		/* just "info level" */
+	Tcl_SetObjResult(interp, Tcl_NewIntObj(currentLevel));
+	return TCL_OK;
+    } else if (objc == 3) {
+	if (Tcl_GetIntFromObj(interp, objv[2], &level) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	if (level > 0) {
+	    level -= currentLevel;
+	}
+	level *= -1;
+	if ((level < 0) || (level > currentLevel)) {
+	    Tcl_AppendResult(interp, "bad level \"",
+		    TclGetString(objv[2]), "\"", (char *) NULL);
+	    return TCL_ERROR;
+	}
+	framePtr = iPtr->framePtr;
+	while (level--) {
+	    framePtr = framePtr->callerPtr;
+	}
+	listPtr = Tcl_NewListObj(framePtr->objc, framePtr->objv);
+	Tcl_SetObjResult(interp, listPtr);
+	return TCL_OK;
+    }
+
+    Tcl_WrongNumArgs(interp, 2, objv, "?number?");
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * InfoFunctionsCmd --
  *
  *	Called to implement the "info functions" command that returns the list
Index: tests/info.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/info.test,v
retrieving revision 1.35
diff -u -r1.35 info.test
--- tests/info.test	6 Apr 2006 18:19:26 -0000	1.35
+++ tests/info.test	9 Jun 2006 18:15:32 -0000
@@ -647,16 +647,16 @@
 } {1 {wrong # args: should be "info option ?arg arg ...?"}}
 test info-21.2 {miscellaneous error conditions} {
     list [catch {info gorp} msg] $msg
-} {1 {bad option "gorp": must be args, body, cmdcount, commands, complete, default, exists, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
+} {1 {bad option "gorp": must be args, body, cmdcount, commands, complete, default, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
 test info-21.3 {miscellaneous error conditions} {
     list [catch {info c} msg] $msg
-} {1 {ambiguous option "c": must be args, body, cmdcount, commands, complete, default, exists, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
+} {1 {ambiguous option "c": must be args, body, cmdcount, commands, complete, default, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
 test info-21.4 {miscellaneous error conditions} {
     list [catch {info l} msg] $msg
-} {1 {ambiguous option "l": must be args, body, cmdcount, commands, complete, default, exists, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
+} {1 {ambiguous option "l": must be args, body, cmdcount, commands, complete, default, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
 test info-21.5 {miscellaneous error conditions} {
     list [catch {info s} msg] $msg
-} {1 {ambiguous option "s": must be args, body, cmdcount, commands, complete, default, exists, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
+} {1 {ambiguous option "s": must be args, body, cmdcount, commands, complete, default, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
 
 # cleanup
 catch {namespace delete test_ns_info1 test_ns_info2}
