Index: doc/info.n
===================================================================
RCS file: /cvsroot/tcl/tcl/doc/info.n,v
retrieving revision 1.17
diff -u -r1.17 info.n
--- doc/info.n	30 May 2005 00:04:45 -0000	1.17
+++ doc/info.n	5 Nov 2006 12:18:52 -0000
@@ -34,6 +34,23 @@
 Returns the body of procedure \fIprocname\fR.  \fIProcname\fR must be
 the name of a Tcl command procedure.
 .TP
+\fBinfo call\fR ?\fInumber\fR?
+If \fInumber\fR is not specified, this command returns a number
+giving the stack level of the invoking procedure, or 0 if the
+command is invoked at top-level.  If \fInumber\fR is specified,
+then the result is a list consisting of the name and arguments for the
+procedure call at level \fInumber\fR on the stack as seen in the source.
+If there were aliases or ensembles involved in the call, this will differ
+from the actual arguments of the procedure call, which can bve retrieved
+with \fbinfo level \fR. The sequence [uplevel 1 [info call 0]] reproduces
+the current call.
+If \fInumber\fR
+is positive then it selects a particular stack level (1 refers
+to the top-most active procedure, 2 to the procedure it called, and
+so on); otherwise it gives a level relative to the current level
+(0 refers to the current procedure, -1 to its caller, and so on).
+See the \fBuplevel\fR command for more information on what stack
+levels mean.
 \fBinfo cmdcount\fR
 Returns a count of the total number of commands that have been invoked
 in this interpreter.
Index: generic/tcl.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tcl.h,v
retrieving revision 1.226
diff -u -r1.226 tcl.h
--- generic/tcl.h	31 Oct 2006 15:23:40 -0000	1.226
+++ generic/tcl.h	5 Nov 2006 12:18:54 -0000
@@ -954,6 +954,8 @@
     int dummy9;
     char *dummy10;
     char *dummy11;
+    int dummy12;
+    char *dummy13;
 } Tcl_CallFrame;
 
 /*
Index: generic/tclCmdIL.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCmdIL.c,v
retrieving revision 1.92
diff -u -r1.92 tclCmdIL.c
--- generic/tclCmdIL.c	2 Nov 2006 15:58:05 -0000	1.92
+++ generic/tclCmdIL.c	5 Nov 2006 12:18:58 -0000
@@ -121,7 +121,7 @@
 static int		InfoHostnameCmd(ClientData dummy, Tcl_Interp *interp,
 			    int objc, Tcl_Obj *CONST objv[]);
 static int		InfoLevelCmd(ClientData dummy, Tcl_Interp *interp,
-			    int objc, Tcl_Obj *CONST objv[]);
+			    int objc, Tcl_Obj *CONST objv[], int isCall);
 static int		InfoLibraryCmd(ClientData dummy, Tcl_Interp *interp,
 			    int objc, Tcl_Obj *CONST objv[]);
 static int		InfoLoadedCmd(ClientData dummy, Tcl_Interp *interp,
@@ -357,14 +357,14 @@
     Tcl_Obj *CONST objv[];	/* Argument objects. */
 {
     static CONST char *subCmds[] = {
-	    "args", "body", "cmdcount", "commands",
+	    "args", "body", "call", "cmdcount", "commands",
 	    "complete", "default", "exists", "functions", "globals",
 	    "hostname", "level", "library", "loaded",
 	    "locals", "nameofexecutable", "patchlevel", "procs",
 	    "script", "sharedlibextension", "tclversion", "vars",
 	    (char *) NULL};
     enum ISubCmdIdx {
-	    IArgsIdx, IBodyIdx, ICmdCountIdx, ICommandsIdx,
+	    IArgsIdx, IBodyIdx, ICallIdx, ICmdCountIdx, ICommandsIdx,
 	    ICompleteIdx, IDefaultIdx, IExistsIdx, IFunctionsIdx, IGlobalsIdx,
 	    IHostnameIdx, ILevelIdx, ILibraryIdx, ILoadedIdx,
 	    ILocalsIdx, INameOfExecutableIdx, IPatchLevelIdx, IProcsIdx,
@@ -390,6 +390,9 @@
 	case IBodyIdx:
 	    result = InfoBodyCmd(clientData, interp, objc, objv);
 	    break;
+	case ICallIdx:
+	    result = InfoLevelCmd(clientData, interp, objc, objv, 1);
+	    break;
 	case ICmdCountIdx:
 	    result = InfoCmdCountCmd(clientData, interp, objc, objv);
 	    break;
@@ -415,7 +418,7 @@
 	    result = InfoHostnameCmd(clientData, interp, objc, objv);
 	    break;
 	case ILevelIdx:
-	    result = InfoLevelCmd(clientData, interp, objc, objv);
+	    result = InfoLevelCmd(clientData, interp, objc, objv, 0);
 	    break;
 	case ILibraryIdx:
 	    result = InfoLibraryCmd(clientData, interp, objc, objv);
@@ -1254,10 +1257,11 @@
  *
  * InfoLevelCmd --
  *
- *	Called to implement the "info level" command that returns information
- *	about the call stack. Handles the following syntax:
+ *	Called to implement the "info level" and "info call" commands that
+ *	return information about the call stack. Handles the following syntax:
  *
  *	    info level ?number?
+ *	    info call  ?number?
  *
  * Results:
  *	Returns TCL_OK if successful and TCL_ERROR if there is an error.
@@ -1270,11 +1274,12 @@
  */
 
 static int
-InfoLevelCmd(dummy, interp, objc, objv)
+InfoLevelCmd(dummy, interp, objc, objv, isCall)
     ClientData dummy;		/* Not used. */
     Tcl_Interp *interp;		/* Current interpreter. */
     int objc;			/* Number of arguments. */
     Tcl_Obj *CONST objv[];	/* Argument objects. */
+    int isCall;                   /* 0 for info level, 1 for info call */ 
 {
     Interp *iPtr = (Interp *) interp;
     int level;
@@ -1307,7 +1312,12 @@
 	    goto levelError;
 	}
 
-	listPtr = Tcl_NewListObj(framePtr->objc, framePtr->objv);
+	if (isCall && (framePtr->isProcCallFrame & FRAME_IS_EXTENDED)
+		&& framePtr->callObjv) {
+	    listPtr = Tcl_NewListObj(framePtr->callObjc, framePtr->callObjv);	    
+	} else {
+	    listPtr = Tcl_NewListObj(framePtr->objc, framePtr->objv);
+	}
 	Tcl_SetObjResult(interp, listPtr);
 	return TCL_OK;
     }
Index: generic/tclInt.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v
retrieving revision 1.292
diff -u -r1.292 tclInt.h
--- generic/tclInt.h	2 Nov 2006 16:57:54 -0000	1.292
+++ generic/tclInt.h	5 Nov 2006 12:19:05 -0000
@@ -857,13 +857,21 @@
 typedef struct CallFrame {
     Namespace *nsPtr;		/* Points to the namespace used to resolve
 				 * commands and global variables. */
-    int isProcCallFrame;	/* If 0, the frame was pushed to execute a
-				 * namespace command and var references are
-				 * treated as references to namespace vars;
-				 * varTablePtr and compiledLocals are ignored.
-				 * If FRAME_IS_PROC is set, the frame was
+    int isProcCallFrame;	/* If FRAME_IS_PROC is set, the frame was
 				 * pushed to execute a Tcl procedure and may
-				 * have local vars. */
+				 * have local vars. Otherwise, the frame was
+				 * pushed to execute a namespace command and
+				 * var references are treated as references to
+				 * namespace vars; varTablePtr and
+				 * compiledLocals are ignored.
+				 * If FRAME_IS_EXTENDED is not set, the
+				 * allocated struct is shorter than this
+				 * definition; this is provided to permit
+				 * binary compatibility with extensions
+				 * compiled against 8.4 headers.
+				 * This field should be called "flags"; the
+				 * old name is retained to permit source
+				 * compat with older extensions. */				 
     int objc;			/* This and objv below describe the arguments
 				 * for this procedure call. */
     Tcl_Obj *CONST *objv;	/* Array of argument objects. */
@@ -897,6 +905,11 @@
 				 * recognized by the compiler. The compiler
 				 * emits code that refers to these variables
 				 * using an index into this array. */
+    /*
+     * This is the end of the struct if FRAME_IS_EXTENDED is not set in
+     * isProcCallFrame. 
+     */
+
     ClientData clientData;	/* Pointer to some context that is used by
 				 * object systems. The meaning of the contents
 				 * of this field is defined by the code that
@@ -906,9 +919,14 @@
 				 * have some means of discovering what the
 				 * meaning of the value is, which we do not
 				 * specify. */
+    int callObjc;               /* This and below describe the source
+				 * arguments that led to this frame being
+				 * pushed, prior to any ensemble rewriting */
+    Tcl_Obj *CONST *callObjv;
 } CallFrame;
 
-#define FRAME_IS_PROC 0x1
+#define FRAME_IS_PROC     0x1
+#define FRAME_IS_EXTENDED 0x2
 
 /*
  *----------------------------------------------------------------
@@ -1518,6 +1536,7 @@
      */
 
     struct {
+	int numSourceObjs;
 	Tcl_Obj *CONST *sourceObjs;
 				/* What arguments were actually input into the
 				 * *root* ensemble command? (Nested ensembles
Index: generic/tclInterp.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInterp.c,v
retrieving revision 1.69
diff -u -r1.69 tclInterp.c
--- generic/tclInterp.c	2 Nov 2006 16:39:06 -0000	1.69
+++ generic/tclInterp.c	5 Nov 2006 12:19:05 -0000
@@ -1729,6 +1729,7 @@
      */
 
     if (isRootEnsemble) {
+	tPtr->ensembleRewrite.numSourceObjs = objc;
 	tPtr->ensembleRewrite.sourceObjs = objv;
 	tPtr->ensembleRewrite.numRemovedObjs = 1;
 	tPtr->ensembleRewrite.numInsertedObjs = prefc;
@@ -1757,6 +1758,7 @@
      */
 
     if (isRootEnsemble) {
+	tPtr->ensembleRewrite.numSourceObjs = 0;
 	tPtr->ensembleRewrite.sourceObjs = NULL;
 	tPtr->ensembleRewrite.numRemovedObjs = 0;
 	tPtr->ensembleRewrite.numInsertedObjs = 0;
Index: generic/tclNamesp.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclNamesp.c,v
retrieving revision 1.117
diff -u -r1.117 tclNamesp.c
--- generic/tclNamesp.c	2 Nov 2006 16:57:54 -0000	1.117
+++ generic/tclNamesp.c	5 Nov 2006 12:19:13 -0000
@@ -549,9 +549,21 @@
 				 * treated as references to namespace
 				 * variables. */
 {
-    *framePtrPtr = (Tcl_CallFrame *) TclStackAlloc(interp, sizeof(CallFrame));
-    return Tcl_PushCallFrame(interp, *framePtrPtr, namespacePtr,
-	    isProcCallFrame);
+    Interp *iPtr = (Interp *) interp;
+    int result;
+    CallFrame *framePtr;
+    
+    framePtr = (CallFrame *) TclStackAlloc(interp, sizeof(CallFrame));
+    *framePtrPtr = (Tcl_CallFrame *) framePtr;
+    result = Tcl_PushCallFrame(interp, *framePtrPtr, namespacePtr,
+	    (isProcCallFrame|FRAME_IS_EXTENDED));
+    if (result != TCL_OK) {
+	return result;
+    }
+
+    framePtr->callObjc = iPtr->ensembleRewrite.numSourceObjs;
+    framePtr->callObjv = iPtr->ensembleRewrite.sourceObjs;
+    return TCL_OK;    
 }
 
 void
@@ -6265,6 +6277,7 @@
 
 	Tcl_ListObjGetElements(NULL, prefixObj, &prefixObjc, &prefixObjv);
 	if (isRootEnsemble) {
+	    iPtr->ensembleRewrite.numSourceObjs = objc;
 	    iPtr->ensembleRewrite.sourceObjs = objv;
 	    iPtr->ensembleRewrite.numRemovedObjs = 2;
 	    iPtr->ensembleRewrite.numInsertedObjs = prefixObjc;
@@ -6286,6 +6299,7 @@
 	Tcl_DecrRefCount(prefixObj);
 	TclStackFree(interp);
 	if (isRootEnsemble) {
+	    iPtr->ensembleRewrite.numSourceObjs = 0;
 	    iPtr->ensembleRewrite.sourceObjs = NULL;
 	    iPtr->ensembleRewrite.numRemovedObjs = 0;
 	    iPtr->ensembleRewrite.numInsertedObjs = 0;
Index: generic/tclProc.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclProc.c,v
retrieving revision 1.105
diff -u -r1.105 tclProc.c
--- generic/tclProc.c	2 Nov 2006 16:39:07 -0000	1.105
+++ generic/tclProc.c	5 Nov 2006 12:19:14 -0000
@@ -2220,6 +2220,7 @@
 
     isRootEnsemble = (iPtr->ensembleRewrite.sourceObjs == NULL);
     if (isRootEnsemble) {
+	iPtr->ensembleRewrite.numSourceObjs = objc;
 	iPtr->ensembleRewrite.sourceObjs = objv;
 	iPtr->ensembleRewrite.numRemovedObjs = 1;
 	iPtr->ensembleRewrite.numInsertedObjs = 0;
@@ -2231,6 +2232,7 @@
 	    &MakeLambdaError);
 
     if (isRootEnsemble) {
+	iPtr->ensembleRewrite.numSourceObjs = 0;
 	iPtr->ensembleRewrite.sourceObjs = NULL;
 	iPtr->ensembleRewrite.numRemovedObjs = 0;
 	iPtr->ensembleRewrite.numInsertedObjs = 0;
Index: tests/info.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/info.test,v
retrieving revision 1.39
diff -u -r1.39 info.test
--- tests/info.test	31 Oct 2006 13:46:33 -0000	1.39
+++ tests/info.test	5 Nov 2006 12:19:15 -0000
@@ -664,16 +664,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, call, cmdcount, commands, complete, default, exists, 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, call, cmdcount, commands, complete, default, exists, 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, call, cmdcount, commands, complete, default, exists, 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, call, cmdcount, commands, complete, default, exists, 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}
