* doc/trace.n: Updated documentation for new syntax; flagged old

syntax as deprecated; added documentation for command
rename/delete traces and variable array traces.

* tests/trace.test: Updated tests for new trace syntax; new tests
for command rename/delete traces; new tests for array traces.

* generic/tclVar.c: Support for new trace syntax; support for
TCL_TRACE_ARRAY.

* generic/tclStubInit.c:
* generic/tclDecls.h:
* generic/tcl.decls: Stub functions for command rename/delete traces.

* generic/tcl.h:
* generic/tclInt.h:
* generic/tclBasic.c: Support for command traces.

* generic/tclCmdMZ.c (TclTraceVariableObjCmd): Patched to support
new [trace] syntax:
trace {add|remove|list} {variable|command} name ops command
Added support for command traces (rename, delete operations).
Added support for TCL_TRACE_ARRAY at Tcl level (array operation
for variable traces).

8 files changed, 1145 insertions, 184 deletions

diff --git a/generic/tcl.decls b/generic/tcl.decls
index ea5b6d2..e71c6ee 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 # 
-# RCS: @(#) $Id: tcl.decls,v 1.38 2000/07/22 01:53:23 ericm Exp $
+# RCS: @(#) $Id: tcl.decls,v 1.39 2000/08/25 02:04:27 ericm Exp $
 
 library tcl
 
@@ -1406,6 +1406,18 @@ declare 405 generic {
 declare 406 generic {
     void Tcl_InitObjHashTable(Tcl_HashTable *tablePtr)
 }
+declare 407 generic {
+    ClientData Tcl_CommandTraceInfo(Tcl_Interp *interp, char *varName, \
+	    int flags, Tcl_CommandTraceProc *procPtr, ClientData prevClientData)
+}
+declare 408 generic {
+    int Tcl_TraceCommand(Tcl_Interp *interp, char *varName, int flags, \
+		Tcl_CommandTraceProc *proc, ClientData clientData)
+}
+declare 409 generic {
+    void Tcl_UntraceCommand(Tcl_Interp *interp, char *varName, int flags, \
+		Tcl_CommandTraceProc *proc, ClientData clientData)
+}
 
 ##############################################################################
 
diff --git a/generic/tcl.h b/generic/tcl.h
index eb8329a..b0b74a4 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -12,7 +12,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tcl.h,v 1.76 2000/08/15 00:08:36 ericm Exp $
+ * RCS: @(#) $Id: tcl.h,v 1.77 2000/08/25 02:04:27 ericm Exp $
  */
 
 #ifndef _TCL
@@ -603,6 +603,8 @@ typedef int (Tcl_SetFromAnyProc) _ANSI_ARGS_((Tcl_Interp *interp,
 typedef void (Tcl_UpdateStringProc) _ANSI_ARGS_((struct Tcl_Obj *objPtr));
 typedef char *(Tcl_VarTraceProc) _ANSI_ARGS_((ClientData clientData,
 	Tcl_Interp *interp, char *part1, char *part2, int flags));
+typedef void (Tcl_CommandTraceProc) _ANSI_ARGS_((ClientData clientData,
+	Tcl_Interp *interp, char *oldName, char *newName, int flags));
 typedef void (Tcl_CreateFileHandlerProc) _ANSI_ARGS_((int fd, int mask,
 	Tcl_FileProc *proc, ClientData clientData));
 typedef void (Tcl_DeleteFileHandlerProc) _ANSI_ARGS_((int fd));
@@ -926,6 +928,17 @@ typedef struct Tcl_DString {
 #define TCL_INTERP_DESTROYED	 0x100
 #define TCL_LEAVE_ERR_MSG	 0x200
 #define TCL_TRACE_ARRAY		 0x800
+#ifndef TCL_REMOVE_OBSOLETE_TRACES
+/* Required to support old variable/vdelete/vinfo traces */
+#define TCL_TRACE_OLD_STYLE	 0x1000
+#endif
+
+/*
+ * Flag values passed to command-related procedures.
+ */
+
+#define TCL_TRACE_RENAME 0x2000
+#define TCL_TRACE_DELETE 0x4000
 
 /*
  * The TCL_PARSE_PART1 flag is deprecated and has no effect. 
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index e9a52e6..47862de 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -12,7 +12,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclBasic.c,v 1.28 2000/05/23 22:10:49 ericm Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.29 2000/08/25 02:04:28 ericm Exp $
  */
 
 #include "tclInt.h"
@@ -25,6 +25,9 @@
  * Static procedures in this file:
  */
 
+static char *		CallCommandTraces _ANSI_ARGS_((Interp *iPtr, 
+			    Command *cmdPtr, char *oldName, 
+			    char* newName, int flags));
 static void		DeleteInterpProc _ANSI_ARGS_((Tcl_Interp *interp));
 static void		ProcessUnexpectedResult _ANSI_ARGS_((
 			    Tcl_Interp *interp, int returnCode));
@@ -335,6 +338,7 @@ Tcl_CreateInterp()
     iPtr->scriptFile = NULL;
     iPtr->flags = 0;
     iPtr->tracePtr = NULL;
+    iPtr->activeCmdTracePtr = NULL;
     iPtr->assocData = (Tcl_HashTable *) NULL;
     iPtr->execEnvPtr = NULL;	      /* set after namespaces initialized */
     iPtr->emptyObjPtr = Tcl_NewObj(); /* another empty object */
@@ -447,8 +451,9 @@ Tcl_CreateInterp()
 	    }
 	    cmdPtr->deleteProc = NULL;
 	    cmdPtr->deleteData = (ClientData) NULL;
-	    cmdPtr->deleted = 0;
+	    cmdPtr->flags = 0;
 	    cmdPtr->importRefPtr = NULL;
+	    cmdPtr->tracePtr = NULL;
 	    Tcl_SetHashValue(hPtr, cmdPtr);
 	}
     }
@@ -1498,8 +1503,9 @@ Tcl_CreateCommand(interp, cmdName, proc, clientData, deleteProc)
     cmdPtr->clientData = clientData;
     cmdPtr->deleteProc = deleteProc;
     cmdPtr->deleteData = clientData;
-    cmdPtr->deleted = 0;
+    cmdPtr->flags = 0;
     cmdPtr->importRefPtr = NULL;
+    cmdPtr->tracePtr = NULL;
 
     /*
      * Plug in any existing import references found above.  Be sure
@@ -1659,8 +1665,9 @@ Tcl_CreateObjCommand(interp, cmdName, proc, clientData, deleteProc)
     cmdPtr->clientData = (ClientData) cmdPtr;
     cmdPtr->deleteProc = deleteProc;
     cmdPtr->deleteData = clientData;
-    cmdPtr->deleted = 0;
+    cmdPtr->flags = 0;
     cmdPtr->importRefPtr = NULL;
+    cmdPtr->tracePtr = NULL;
 
     /*
      * Plug in any existing import references found above.  Be sure
@@ -1975,6 +1982,8 @@ TclRenameCommand(interp, oldName, newName)
         return result;
     }
 
+    CallCommandTraces(iPtr,cmdPtr,oldName,newName,TCL_TRACE_RENAME);
+
     /*
      * The new command name is okay, so remove the command from its
      * current namespace. This is like deleting the command, so bump
@@ -2281,7 +2290,7 @@ Tcl_DeleteCommandFromToken(interp, cmd)
      * flag allows us to detect these cases and skip nested deletes.
      */
 
-    if (cmdPtr->deleted) {
+    if (cmdPtr->flags & CMD_IS_DELETED) {
 	/*
 	 * Another deletion is already in progress.  Remove the hash
 	 * table entry now, but don't invoke a callback or free the
@@ -2293,6 +2302,33 @@ Tcl_DeleteCommandFromToken(interp, cmd)
 	return 0;
     }
 
+    /* 
+     * We must delete this command, even though both traces and
+     * delete procs may try to avoid this (renaming the command etc).
+     * Also traces and delete procs may try to delete the command
+     * themsevles.  This flag declares that a delete is in progress
+     * and that recursive deletes should be ignored.
+     */
+    cmdPtr->flags |= CMD_IS_DELETED;
+
+    /*
+     * Call trace procedures for the command being deleted. Then delete
+     * its traces. 
+     */
+
+    if (cmdPtr->tracePtr != NULL) {
+	CommandTrace *tracePtr;
+	CallCommandTraces(iPtr,cmdPtr,NULL,NULL,TCL_TRACE_DELETE);
+	/* Now delete these traces */
+	tracePtr = cmdPtr->tracePtr;
+	while (tracePtr != NULL) {
+	    CommandTrace *nextPtr = tracePtr->nextPtr;
+	    ckfree((char *) tracePtr);
+	    tracePtr = nextPtr;
+	}
+	cmdPtr->tracePtr = NULL;
+    }
+    
     /*
      * If the command being deleted has a compile procedure, increment the
      * interpreter's compileEpoch to invalidate its compiled code. This
@@ -2306,7 +2342,6 @@ Tcl_DeleteCommandFromToken(interp, cmd)
         iPtr->compileEpoch++;
     }
 
-    cmdPtr->deleted = 1;
     if (cmdPtr->deleteProc != NULL) {
 	/*
 	 * Delete the command's client data. If this was an imported command
@@ -2381,6 +2416,75 @@ Tcl_DeleteCommandFromToken(interp, cmd)
     TclCleanupCommand(cmdPtr);
     return 0;
 }
+static char *
+CallCommandTraces(iPtr, cmdPtr, oldName, newName, flags)
+    Interp *iPtr;		/* Interpreter containing variable. */
+    Command *cmdPtr;		/* Variable whose traces are to be
+				 * invoked. */
+    char *oldName;	        /* Command's old name, or NULL if we
+                                 * must get the name from cmdPtr */
+    char *newName;	        /* Command's new name, or NULL if
+                                 * the command is not being renamed */
+    int flags;			/* Flags passed to trace procedures:
+				 * indicates what's happening to variable,
+				 * plus other stuff like TCL_GLOBAL_ONLY,
+				 * TCL_NAMESPACE_ONLY, and
+				 * TCL_INTERP_DESTROYED. */
+{
+    register CommandTrace *tracePtr;
+    ActiveCommandTrace active;
+    char *result;
+    if (cmdPtr->flags & CMD_TRACE_ACTIVE) {
+	/* 
+	 * While a rename trace is active, we will not process any more
+	 * rename traces; while a delete trace is active we will not
+	 * process any more delete traces 
+	 */
+	if (cmdPtr->flags & TCL_TRACE_RENAME) {
+	    flags &= ~TCL_TRACE_RENAME;
+	}
+	if (cmdPtr->flags & TCL_TRACE_DELETE) {
+	    flags &= ~TCL_TRACE_DELETE;
+	}
+	if (flags == 0) {
+	    return NULL;
+	}
+    }
+    cmdPtr->flags |= CMD_TRACE_ACTIVE;
+    cmdPtr->refCount++;
+    
+    result = NULL;
+    active.nextPtr = iPtr->activeCmdTracePtr;
+    iPtr->activeCmdTracePtr = &active;
+
+    active.cmdPtr = cmdPtr;
+    for (tracePtr = cmdPtr->tracePtr; tracePtr != NULL;
+	 tracePtr = active.nextTracePtr) {
+	active.nextTracePtr = tracePtr->nextPtr;
+	if (!(tracePtr->flags & flags)) {
+	    continue;
+	}
+	cmdPtr->flags |= tracePtr->flags;
+	if (oldName == NULL) {
+	    oldName = Tcl_GetCommandName((Tcl_Interp *) iPtr, 
+					 (Tcl_Command) cmdPtr);
+	}
+	(*tracePtr->traceProc)(tracePtr->clientData,
+		(Tcl_Interp *) iPtr, oldName, newName, flags);
+	cmdPtr->flags &= ~tracePtr->flags;
+    }
+
+    /*
+     * Restore the variable's flags, remove the record of our active
+     * traces, and then return.
+     */
+
+    cmdPtr->flags &= ~CMD_TRACE_ACTIVE;
+    cmdPtr->refCount--;
+    iPtr->activeCmdTracePtr = active.nextPtr;
+    return result;
+}
+
 
 /*
  *----------------------------------------------------------------------
@@ -3870,11 +3974,11 @@ Tcl_CreateTrace(interp, level, proc, clientData)
     iPtr->flags |= DONT_COMPILE_CMDS_INLINE;
 
     tracePtr = (Trace *) ckalloc(sizeof(Trace));
-    tracePtr->level = level;
-    tracePtr->proc = proc;
-    tracePtr->clientData = clientData;
-    tracePtr->nextPtr = iPtr->tracePtr;
-    iPtr->tracePtr = tracePtr;
+    tracePtr->level		= level;
+    tracePtr->proc		= proc;
+    tracePtr->clientData	= clientData;
+    tracePtr->nextPtr		= iPtr->tracePtr;
+    iPtr->tracePtr		= tracePtr;
 
     return (Tcl_Trace) tracePtr;
 }
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index cc17067..2421158 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -13,7 +13,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCmdMZ.c,v 1.27 2000/05/26 08:51:11 hobbs Exp $
+ * RCS: @(#) $Id: tclCmdMZ.c,v 1.28 2000/08/25 02:04:28 ericm Exp $
  */
 
 #include "tclInt.h"
@@ -55,12 +55,43 @@ typedef struct {
 } TraceVarInfo;
 
 /*
+ * The same structure is used for command traces at present
+ */
+
+typedef TraceVarInfo TraceCommandInfo;
+
+/*
  * Forward declarations for procedures defined in this file:
  */
 
+typedef int (Tcl_TraceTypeObjCmd) _ANSI_ARGS_((Tcl_Interp *interp,
+	int optionIndex, int objc, Tcl_Obj *CONST objv[]));
+
+Tcl_TraceTypeObjCmd TclTraceVariableObjCmd;
+Tcl_TraceTypeObjCmd TclTraceCommandObjCmd;
+
+/* 
+ * Each subcommand has a number of 'types' to which it can apply.
+ * Currently 'command' and 'variable' are the only
+ * types supported.  These two arrays MUST be kept in sync!
+ * In the future we may provide an API to add to the list of
+ * supported trace types.
+ */
+static char *traceTypeOptions[] = {
+    "command", "variable", (char*) NULL
+};
+static Tcl_TraceTypeObjCmd* traceSubCmds[] = {
+    TclTraceCommandObjCmd,
+    TclTraceVariableObjCmd,
+};
+
 static char *		TraceVarProc _ANSI_ARGS_((ClientData clientData,
 			    Tcl_Interp *interp, char *name1, char *name2,
 			    int flags));
+static void		TraceCommandProc _ANSI_ARGS_((ClientData clientData,
+			    Tcl_Interp *interp, char *oldName, char *newName,
+			    int flags));
+
 
 /*
  *----------------------------------------------------------------------
@@ -2469,13 +2500,17 @@ Tcl_TimeObjCmd(dummy, interp, objc, objv)
  *
  *	This procedure is invoked to process the "trace" Tcl command.
  *	See the user documentation for details on what it does.
+ *	
+ *	Standard syntax as of Tcl 8.4 is
+ *	
+ *	 trace {add|remove|list} {command|variable} name ops cmd
+ *
  *
  * Results:
  *	A standard Tcl result.
  *
  * Side effects:
  *	See the user documentation.
- *
  *----------------------------------------------------------------------
  */
 
@@ -2488,17 +2523,26 @@ Tcl_TraceObjCmd(dummy, interp, objc, objv)
     Tcl_Obj *CONST objv[];		/* Argument objects. */
 {
     int optionIndex, commandLength;
-    char *name, *rwuOps, *command, *p;
+    char *name, *flagOps, *command, *p;
     size_t length;
+    /* Main sub commands to 'trace' */
     static char *traceOptions[] = {
-	"variable", "vdelete", "vinfo", (char *) NULL
+	"add", "list", "remove", 
+#ifndef TCL_REMOVE_OBSOLETE_TRACES
+	"variable", "vdelete", "vinfo", 
+#endif
+	(char *) NULL
     };
+    /* 'OLD' options are pre-Tcl-8.4 style */
     enum traceOptions {
-	TRACE_VARIABLE,       TRACE_VDELETE,      TRACE_VINFO
+	TRACE_ADD, TRACE_LIST, TRACE_REMOVE, 
+#ifndef TCL_REMOVE_OBSOLETE_TRACES
+	TRACE_OLD_VARIABLE, TRACE_OLD_VDELETE, TRACE_OLD_VINFO
+#endif
     };
 
     if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "option [arg arg ...]");
+	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
 	return TCL_ERROR;
     }
 
@@ -2507,33 +2551,449 @@ Tcl_TraceObjCmd(dummy, interp, objc, objv)
 	return TCL_ERROR;
     }
     switch ((enum traceOptions) optionIndex) {
-	    case TRACE_VARIABLE: {
-		int flags;
-		TraceVarInfo *tvarPtr;
-		if (objc != 5) {
-		    Tcl_WrongNumArgs(interp, 2, objv, "name ops command");
-		    return TCL_ERROR;
+	case TRACE_ADD: 
+	case TRACE_REMOVE:
+	case TRACE_LIST: {
+	    /* 
+	     * All sub commands of trace add/remove must take at least
+	     * one more argument.  Beyond that we let the subcommand itself
+	     * control the argument structure.
+	     */
+	    int typeIndex;
+	    if (objc < 3) {
+		Tcl_WrongNumArgs(interp, 2, objv, "type ?arg arg ...?");
+		return TCL_ERROR;
+	    }
+	    if (Tcl_GetIndexFromObj(interp, objv[2], traceTypeOptions,
+			"option", 0, &typeIndex) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    return (traceSubCmds[typeIndex])(interp, optionIndex, objc, objv);
+	    break;
+	}
+#ifndef TCL_REMOVE_OBSOLETE_TRACES
+        case TRACE_OLD_VARIABLE: {
+	    int flags;
+	    TraceVarInfo *tvarPtr;
+	    if (objc != 5) {
+		Tcl_WrongNumArgs(interp, 2, objv, "name ops command");
+		return TCL_ERROR;
+	    }
+
+	    flags = 0;
+	    flagOps = Tcl_GetString(objv[3]);
+	    for (p = flagOps; *p != 0; p++) {
+		if (*p == 'r') {
+		    flags |= TCL_TRACE_READS;
+		} else if (*p == 'w') {
+		    flags |= TCL_TRACE_WRITES;
+		} else if (*p == 'u') {
+		    flags |= TCL_TRACE_UNSETS;
+		} else if (*p == 'a') {
+		    flags |= TCL_TRACE_ARRAY;
+		} else {
+		    goto badVarOps;
 		}
+	    }
+	    if (flags == 0) {
+		goto badVarOps;
+	    }
+	    flags |= TCL_TRACE_OLD_STYLE;
+	    
+	    command = Tcl_GetStringFromObj(objv[4], &commandLength);
+	    length = (size_t) commandLength;
+	    tvarPtr = (TraceVarInfo *) ckalloc((unsigned)
+		    (sizeof(TraceVarInfo) - sizeof(tvarPtr->command)
+			    + length + 1));
+	    tvarPtr->flags = flags;
+	    tvarPtr->errMsg = NULL;
+	    tvarPtr->length = length;
+	    flags |= TCL_TRACE_UNSETS;
+	    strcpy(tvarPtr->command, command);
+	    name = Tcl_GetString(objv[2]);
+	    if (Tcl_TraceVar(interp, name, flags, TraceVarProc,
+		    (ClientData) tvarPtr) != TCL_OK) {
+		ckfree((char *) tvarPtr);
+		return TCL_ERROR;
+	    }
+	    break;
+	}
+	case TRACE_OLD_VDELETE: {
+	    int flags;
+	    TraceVarInfo *tvarPtr;
+	    ClientData clientData;
 
-		flags = 0;
-		rwuOps = Tcl_GetString(objv[3]);
-		for (p = rwuOps; *p != 0; p++) {
-		    if (*p == 'r') {
-			flags |= TCL_TRACE_READS;
-		    } else if (*p == 'w') {
-			flags |= TCL_TRACE_WRITES;
-		    } else if (*p == 'u') {
-			flags |= TCL_TRACE_UNSETS;
-		    } else {
-			goto badOps;
+	    if (objc != 5) {
+		Tcl_WrongNumArgs(interp, 2, objv, "name ops command");
+		return TCL_ERROR;
+	    }
+
+	    flags = 0;
+	    flagOps = Tcl_GetString(objv[3]);
+	    for (p = flagOps; *p != 0; p++) {
+		if (*p == 'r') {
+		    flags |= TCL_TRACE_READS;
+		} else if (*p == 'w') {
+		    flags |= TCL_TRACE_WRITES;
+		} else if (*p == 'u') {
+		    flags |= TCL_TRACE_UNSETS;
+		} else if (*p == 'a') {
+		    flags |= TCL_TRACE_ARRAY;
+		} else {
+		    goto badVarOps;
+		}
+	    }
+	    if (flags == 0) {
+		goto badVarOps;
+	    }
+	    flags |= TCL_TRACE_OLD_STYLE;
+
+	    /*
+	     * Search through all of our traces on this variable to
+	     * see if there's one with the given command.  If so, then
+	     * delete the first one that matches.
+	     */
+
+	    command = Tcl_GetStringFromObj(objv[4], &commandLength);
+	    length = (size_t) commandLength;
+	    clientData = 0;
+	    name = Tcl_GetString(objv[2]);
+	    while ((clientData = Tcl_VarTraceInfo(interp, name, 0,
+		    TraceVarProc, clientData)) != 0) {
+		tvarPtr = (TraceVarInfo *) clientData;
+		if ((tvarPtr->length == length) && (tvarPtr->flags == flags)
+			&& (strncmp(command, tvarPtr->command,
+				(size_t) length) == 0)) {
+		    Tcl_UntraceVar(interp, name, flags | TCL_TRACE_UNSETS,
+			    TraceVarProc, clientData);
+		    if (tvarPtr->errMsg != NULL) {
+			ckfree(tvarPtr->errMsg);
+		    }
+		    ckfree((char *) tvarPtr);
+		    break;
+		}
+	    }
+	    break;
+	}
+	case TRACE_OLD_VINFO: {
+	    ClientData clientData;
+	    char ops[5];
+	    Tcl_Obj *resultListPtr, *pairObjPtr, *elemObjPtr;
+
+	    if (objc != 3) {
+		Tcl_WrongNumArgs(interp, 2, objv, "name");
+		return TCL_ERROR;
+	    }
+	    resultListPtr = Tcl_GetObjResult(interp);
+	    clientData = 0;
+	    name = Tcl_GetString(objv[2]);
+	    while ((clientData = Tcl_VarTraceInfo(interp, name, 0,
+		    TraceVarProc, clientData)) != 0) {
+
+		TraceVarInfo *tvarPtr = (TraceVarInfo *) clientData;
+
+		pairObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+		p = ops;
+		if (tvarPtr->flags & TCL_TRACE_READS) {
+		    *p = 'r';
+		    p++;
+		}
+		if (tvarPtr->flags & TCL_TRACE_WRITES) {
+		    *p = 'w';
+		    p++;
+		}
+		if (tvarPtr->flags & TCL_TRACE_UNSETS) {
+		    *p = 'u';
+		    p++;
+		}
+		if (tvarPtr->flags & TCL_TRACE_ARRAY) {
+		    *p = 'a';
+		    p++;
+		}
+		*p = '\0';
+
+		/*
+		 * Build a pair (2-item list) with the ops string as
+		 * the first obj element and the tvarPtr->command string
+		 * as the second obj element.  Append the pair (as an
+		 * element) to the end of the result object list.
+		 */
+
+		elemObjPtr = Tcl_NewStringObj(ops, -1);
+		Tcl_ListObjAppendElement(NULL, pairObjPtr, elemObjPtr);
+		elemObjPtr = Tcl_NewStringObj(tvarPtr->command, -1);
+		Tcl_ListObjAppendElement(NULL, pairObjPtr, elemObjPtr);
+		Tcl_ListObjAppendElement(interp, resultListPtr, pairObjPtr);
+	    }
+	    Tcl_SetObjResult(interp, resultListPtr);
+	    break;
+	}
+#endif /* TCL_REMOVE_OBSOLETE_TRACES */
+    }
+    return TCL_OK;
+
+    badVarOps:
+    Tcl_AppendResult(interp, "bad operations \"", flagOps,
+	    "\": should be one or more of rwua", (char *) NULL);
+    return TCL_ERROR;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclTraceCommandObjCmd --
+ *
+ *	Helper function for Tcl_TraceObjCmd; implements the
+ *	[trace {add|remove|list} command ...] subcommands.
+ *	See the user documentation for details on what these do.
+ *
+ * Results:
+ *	Standard Tcl result.
+ *
+ * Side effects:
+ *	Depends on the operation (add, remove, or list) being performed;
+ *	may add or remove command traces on a command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclTraceCommandObjCmd(interp, optionIndex, objc, objv)
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int optionIndex;			/* Add, list or remove */
+    int objc;				/* Number of arguments. */
+    Tcl_Obj *CONST objv[];		/* Argument objects. */
+{
+    int commandLength, index;
+    char *name, *command;
+    size_t length;
+    enum traceOptions { TRACE_ADD, TRACE_LIST, TRACE_REMOVE };
+    static char *opStrings[] = { "delete", "rename", (char *) NULL };
+    enum operations { TRACE_CMD_DELETE, TRACE_CMD_RENAME };
+    
+    switch ((enum traceOptions) optionIndex) {
+	case TRACE_ADD: 
+	case TRACE_REMOVE: {
+	    int flags = 0;
+	    int i, listLen, result;
+	    Tcl_Obj **elemPtrs;
+	    if (objc != 6) {
+		Tcl_WrongNumArgs(interp, 3, objv, "name opList command");
+		return TCL_ERROR;
+	    }
+	    /*
+	     * Make sure the ops argument is a list object; get its length and
+	     * a pointer to its array of element pointers.
+	     */
+
+	    result = Tcl_ListObjGetElements(interp, objv[4], &listLen,
+		    &elemPtrs);
+	    if (result != TCL_OK) {
+		return result;
+	    }
+	    if (listLen == 0) {
+		Tcl_SetResult(interp, "bad operation list \"\": must be "
+			"one or more of delete or rename", TCL_STATIC);
+		return TCL_ERROR;
+	    }
+	    for (i = 0; i < listLen; i++) {
+		if (Tcl_GetIndexFromObj(interp, elemPtrs[i], opStrings,
+			"operation", TCL_EXACT, &index) != TCL_OK) {
+		    return TCL_ERROR;
+		}
+		switch ((enum operations) index) {
+		    case TRACE_CMD_RENAME:
+			flags |= TCL_TRACE_RENAME;
+			break;
+		    case TRACE_CMD_DELETE:
+			flags |= TCL_TRACE_DELETE;
+			break;
+		}
+	    }
+	    command = Tcl_GetStringFromObj(objv[5], &commandLength);
+	    length = (size_t) commandLength;
+	    if ((enum traceOptions) optionIndex == TRACE_ADD) {
+		TraceCommandInfo *tcmdPtr;
+		tcmdPtr = (TraceCommandInfo *) ckalloc((unsigned)
+			(sizeof(TraceCommandInfo) - sizeof(tcmdPtr->command)
+				+ length + 1));
+		tcmdPtr->flags = flags;
+		tcmdPtr->errMsg = NULL;
+		tcmdPtr->length = length;
+		flags |= TCL_TRACE_DELETE;
+		strcpy(tcmdPtr->command, command);
+		name = Tcl_GetString(objv[3]);
+		if (Tcl_TraceCommand(interp, name, flags, TraceCommandProc,
+			(ClientData) tcmdPtr) != TCL_OK) {
+		    ckfree((char *) tcmdPtr);
+		    return TCL_ERROR;
+		}
+	    } else {
+		/*
+		 * Search through all of our traces on this command to
+		 * see if there's one with the given command.  If so, then
+		 * delete the first one that matches.
+		 */
+		
+		TraceCommandInfo *tcmdPtr;
+		ClientData clientData;
+		clientData = 0;
+		name = Tcl_GetString(objv[3]);
+		while ((clientData = Tcl_CommandTraceInfo(interp, name, 0,
+			TraceCommandProc, clientData)) != 0) {
+		    tcmdPtr = (TraceCommandInfo *) clientData;
+		    if ((tcmdPtr->length == length)
+			    && (tcmdPtr->flags == flags)
+			    && (strncmp(command, tcmdPtr->command,
+				    (size_t) length) == 0)) {
+			Tcl_UntraceCommand(interp, name,
+				flags | TCL_TRACE_DELETE,
+				TraceCommandProc, clientData);
+			if (tcmdPtr->errMsg != NULL) {
+			    ckfree(tcmdPtr->errMsg);
+			}
+			ckfree((char *) tcmdPtr);
+			break;
 		    }
 		}
-		if (flags == 0) {
-		    goto badOps;
+	    }
+	    break;
+	}
+	case TRACE_LIST: {
+	    ClientData clientData;
+	    Tcl_Obj *resultListPtr, *eachTraceObjPtr, *elemObjPtr;
+	    if (objc != 4) {
+		Tcl_WrongNumArgs(interp, 3, objv, "name");
+		return TCL_ERROR;
+	    }
+
+	    resultListPtr = Tcl_GetObjResult(interp);
+	    clientData = 0;
+	    name = Tcl_GetString(objv[3]);
+	    while ((clientData = Tcl_CommandTraceInfo(interp, name, 0,
+		    TraceCommandProc, clientData)) != 0) {
+
+		TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) clientData;
+
+		eachTraceObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+
+		/*
+		 * Build a list with the ops list as
+		 * the first obj element and the tcmdPtr->command string
+		 * as the second obj element.  Append this list (as an
+		 * element) to the end of the result object list.
+		 */
+
+		elemObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+		if (tcmdPtr->flags & TCL_TRACE_RENAME) {
+		    Tcl_ListObjAppendElement(NULL, elemObjPtr,
+			    Tcl_NewStringObj("rename",6));
 		}
+		if (tcmdPtr->flags & TCL_TRACE_DELETE) {
+		    Tcl_ListObjAppendElement(NULL, elemObjPtr,
+			    Tcl_NewStringObj("delete",6));
+		}
+		Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr);
 
-		command = Tcl_GetStringFromObj(objv[4], &commandLength);
-		length = (size_t) commandLength;
+		elemObjPtr = Tcl_NewStringObj(tcmdPtr->command, -1);
+		Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr);
+		Tcl_ListObjAppendElement(interp, resultListPtr,
+			eachTraceObjPtr);
+	    }
+	    Tcl_SetObjResult(interp, resultListPtr);
+	    break;
+	}
+    }
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclTraceVariableObjCmd --
+ *
+ *	Helper function for Tcl_TraceObjCmd; implements the
+ *	[trace {add|remove|list} variable ...] subcommands.
+ *	See the user documentation for details on what these do.
+ *
+ * Results:
+ *	Standard Tcl result.
+ *
+ * Side effects:
+ *	Depends on the operation (add, remove, or list) being performed;
+ *	may add or remove variable traces on a variable.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclTraceVariableObjCmd(interp, optionIndex, objc, objv)
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int optionIndex;			/* Add, list or remove */
+    int objc;				/* Number of arguments. */
+    Tcl_Obj *CONST objv[];		/* Argument objects. */
+{
+    int commandLength, index;
+    char *name, *command;
+    size_t length;
+    enum traceOptions { TRACE_ADD, TRACE_LIST, TRACE_REMOVE };
+    static char *opStrings[] = { "array", "read", "unset", "write",
+				     (char *) NULL };
+    enum operations { TRACE_VAR_ARRAY, TRACE_VAR_READ, TRACE_VAR_UNSET,
+			  TRACE_VAR_WRITE };
+        
+    switch ((enum traceOptions) optionIndex) {
+	case TRACE_ADD: 
+	case TRACE_REMOVE: {
+	    int flags = 0;
+	    int i, listLen, result;
+	    Tcl_Obj **elemPtrs;
+	    if (objc != 6) {
+		Tcl_WrongNumArgs(interp, 3, objv, "name opList command");
+		return TCL_ERROR;
+	    }
+	    /*
+	     * Make sure the ops argument is a list object; get its length and
+	     * a pointer to its array of element pointers.
+	     */
+
+	    result = Tcl_ListObjGetElements(interp, objv[4], &listLen,
+		    &elemPtrs);
+	    if (result != TCL_OK) {
+		return result;
+	    }
+	    if (listLen == 0) {
+		Tcl_SetResult(interp, "bad operation list \"\": must be "
+			"one or more of array, read, unset, or write",
+			TCL_STATIC);
+		return TCL_ERROR;
+	    }
+	    for (i = 0; i < listLen ; i++) {
+		if (Tcl_GetIndexFromObj(interp, elemPtrs[i], opStrings,
+			"operation", TCL_EXACT, &index) != TCL_OK) {
+		    return TCL_ERROR;
+		}
+		switch ((enum operations) index) {
+		    case TRACE_VAR_ARRAY:
+			flags |= TCL_TRACE_ARRAY;
+			break;
+		    case TRACE_VAR_READ:
+			flags |= TCL_TRACE_READS;
+			break;
+		    case TRACE_VAR_UNSET:
+			flags |= TCL_TRACE_UNSETS;
+			break;
+		    case TRACE_VAR_WRITE:
+			flags |= TCL_TRACE_WRITES;
+			break;
+		}
+	    }
+	    command = Tcl_GetStringFromObj(objv[5], &commandLength);
+	    length = (size_t) commandLength;
+	    if ((enum traceOptions) optionIndex == TRACE_ADD) {
+		TraceVarInfo *tvarPtr;
 		tvarPtr = (TraceVarInfo *) ckalloc((unsigned)
 			(sizeof(TraceVarInfo) - sizeof(tvarPtr->command)
 				+ length + 1));
@@ -2542,55 +3002,27 @@ Tcl_TraceObjCmd(dummy, interp, objc, objv)
 		tvarPtr->length = length;
 		flags |= TCL_TRACE_UNSETS;
 		strcpy(tvarPtr->command, command);
-		name = Tcl_GetString(objv[2]);
+		name = Tcl_GetString(objv[3]);
 		if (Tcl_TraceVar(interp, name, flags, TraceVarProc,
 			(ClientData) tvarPtr) != TCL_OK) {
 		    ckfree((char *) tvarPtr);
 		    return TCL_ERROR;
 		}
-		break;
-	    }
-	    case TRACE_VDELETE: {
-		int flags;
-		TraceVarInfo *tvarPtr;
-		ClientData clientData;
-
-		if (objc != 5) {
-		    Tcl_WrongNumArgs(interp, 2, objv, "name ops command");
-		    return TCL_ERROR;
-		}
-
-		flags = 0;
-		rwuOps = Tcl_GetString(objv[3]);
-		for (p = rwuOps; *p != 0; p++) {
-		    if (*p == 'r') {
-			flags |= TCL_TRACE_READS;
-		    } else if (*p == 'w') {
-			flags |= TCL_TRACE_WRITES;
-		    } else if (*p == 'u') {
-			flags |= TCL_TRACE_UNSETS;
-		    } else {
-			goto badOps;
-		    }
-		}
-		if (flags == 0) {
-		    goto badOps;
-		}
-
+	    } else {
 		/*
 		 * Search through all of our traces on this variable to
 		 * see if there's one with the given command.  If so, then
 		 * delete the first one that matches.
 		 */
 		
-		command = Tcl_GetStringFromObj(objv[4], &commandLength);
-		length = (size_t) commandLength;
-		clientData = 0;
-		name = Tcl_GetString(objv[2]);
+		TraceVarInfo *tvarPtr;
+		ClientData clientData = 0;
+		name = Tcl_GetString(objv[3]);
 		while ((clientData = Tcl_VarTraceInfo(interp, name, 0,
 			TraceVarProc, clientData)) != 0) {
 		    tvarPtr = (TraceVarInfo *) clientData;
-		    if ((tvarPtr->length == length) && (tvarPtr->flags == flags)
+		    if ((tvarPtr->length == length)
+			    && (tvarPtr->flags == flags)
 			    && (strncmp(command, tvarPtr->command,
 				    (size_t) length) == 0)) {
 			Tcl_UntraceVar(interp, name, flags | TCL_TRACE_UNSETS,
@@ -2602,67 +3034,339 @@ Tcl_TraceObjCmd(dummy, interp, objc, objv)
 			break;
 		    }
 		}
-		break;
 	    }
-	    case TRACE_VINFO: {
-		ClientData clientData;
-		char ops[4];
-		Tcl_Obj *resultListPtr, *pairObjPtr, *elemObjPtr;
+	    break;
+	}
+	case TRACE_LIST: {
+	    ClientData clientData;
+	    Tcl_Obj *resultListPtr, *eachTraceObjPtr, *elemObjPtr;
+	    if (objc != 4) {
+		Tcl_WrongNumArgs(interp, 3, objv, "name");
+		return TCL_ERROR;
+	    }
 
-		if (objc != 3) {
-		    Tcl_WrongNumArgs(interp, 2, objv, "name");
-		    return TCL_ERROR;
+	    resultListPtr = Tcl_GetObjResult(interp);
+	    clientData = 0;
+	    name = Tcl_GetString(objv[3]);
+	    while ((clientData = Tcl_VarTraceInfo(interp, name, 0,
+		    TraceVarProc, clientData)) != 0) {
+
+		TraceVarInfo *tvarPtr = (TraceVarInfo *) clientData;
+
+		eachTraceObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+		/*
+		 * Build a list with the ops list as
+		 * the first obj element and the tcmdPtr->command string
+		 * as the second obj element.  Append this list (as an
+		 * element) to the end of the result object list.
+		 */
+
+		elemObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+		if (tvarPtr->flags & TCL_TRACE_ARRAY) {
+		    Tcl_ListObjAppendElement(NULL, elemObjPtr,
+			    Tcl_NewStringObj("array", 5));
 		}
-		resultListPtr = Tcl_GetObjResult(interp);
-		clientData = 0;
-		name = Tcl_GetString(objv[2]);
-		while ((clientData = Tcl_VarTraceInfo(interp, name, 0,
-			TraceVarProc, clientData)) != 0) {
+		if (tvarPtr->flags & TCL_TRACE_READS) {
+		    Tcl_ListObjAppendElement(NULL, elemObjPtr,
+			    Tcl_NewStringObj("read", 4));
+		}
+		if (tvarPtr->flags & TCL_TRACE_WRITES) {
+		    Tcl_ListObjAppendElement(NULL, elemObjPtr,
+			    Tcl_NewStringObj("write", 5));
+		}
+		if (tvarPtr->flags & TCL_TRACE_UNSETS) {
+		    Tcl_ListObjAppendElement(NULL, elemObjPtr,
+			    Tcl_NewStringObj("unset", 5));
+		}
+		Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr);
 
-		    TraceVarInfo *tvarPtr = (TraceVarInfo *) clientData;
+		elemObjPtr = Tcl_NewStringObj(tvarPtr->command, -1);
+		Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr);
+		Tcl_ListObjAppendElement(interp, resultListPtr,
+			eachTraceObjPtr);
+	    }
+	    Tcl_SetObjResult(interp, resultListPtr);
+	    break;
+	}
+    }
+    return TCL_OK;
+}
 
-		    pairObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
-		    p = ops;
-		    if (tvarPtr->flags & TCL_TRACE_READS) {
-			*p = 'r';
-			p++;
-		    }
-		    if (tvarPtr->flags & TCL_TRACE_WRITES) {
-			*p = 'w';
-			p++;
-		    }
-		    if (tvarPtr->flags & TCL_TRACE_UNSETS) {
-			*p = 'u';
-			p++;
-		    }
-		    *p = '\0';
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_CommandTraceInfo --
+ *
+ *	Return the clientData value associated with a trace on a
+ *	command.  This procedure can also be used to step through
+ *	all of the traces on a particular command that have the
+ *	same trace procedure.
+ *
+ * Results:
+ *	The return value is the clientData value associated with
+ *	a trace on the given command.  Information will only be
+ *	returned for a trace with proc as trace procedure.  If
+ *	the clientData argument is NULL then the first such trace is
+ *	returned;  otherwise, the next relevant one after the one
+ *	given by clientData will be returned.  If the command
+ *	doesn't exist, or if there are no (more) traces for it,
+ *	then NULL is returned.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
 
-		    /*
-		     * Build a pair (2-item list) with the ops string as
-		     * the first obj element and the tvarPtr->command string
-		     * as the second obj element.  Append the pair (as an
-		     * element) to the end of the result object list.
-		     */
+ClientData
+Tcl_CommandTraceInfo(interp, cmdName, flags, proc, prevClientData)
+    Tcl_Interp *interp;		/* Interpreter containing command. */
+    char *cmdName;		/* Name of command. */
+    int flags;			/* OR-ed combo or TCL_GLOBAL_ONLY,
+				 * TCL_NAMESPACE_ONLY (can be 0). */
+    Tcl_CommandTraceProc *proc;	/* Procedure assocated with trace. */
+    ClientData prevClientData;	/* If non-NULL, gives last value returned
+				 * by this procedure, so this call will
+				 * return the next trace after that one.
+				 * If NULL, this call will return the
+				 * first trace. */
+{
+    Command *cmdPtr;
+    register CommandTrace *tracePtr;
 
-		    elemObjPtr = Tcl_NewStringObj(ops, -1);
-		    Tcl_ListObjAppendElement(NULL, pairObjPtr, elemObjPtr);
-		    elemObjPtr = Tcl_NewStringObj(tvarPtr->command, -1);
-		    Tcl_ListObjAppendElement(NULL, pairObjPtr, elemObjPtr);
-		    Tcl_ListObjAppendElement(interp, resultListPtr, pairObjPtr);
-		}
-		Tcl_SetObjResult(interp, resultListPtr);
+    cmdPtr = (Command*)Tcl_FindCommand(interp, cmdName, 
+		NULL, TCL_LEAVE_ERR_MSG);
+    if (cmdPtr == NULL) {
+	return NULL;
+    }
+
+    /*
+     * Find the relevant trace, if any, and return its clientData.
+     */
+
+    tracePtr = cmdPtr->tracePtr;
+    if (prevClientData != NULL) {
+	for ( ;  tracePtr != NULL;  tracePtr = tracePtr->nextPtr) {
+	    if ((tracePtr->clientData == prevClientData)
+		    && (tracePtr->traceProc == proc)) {
+		tracePtr = tracePtr->nextPtr;
 		break;
 	    }
-	default: {
-		panic("Tcl_TraceObjCmd: bad option index to TraceOptions");
-	    }
+	}
     }
+    for ( ;  tracePtr != NULL;  tracePtr = tracePtr->nextPtr) {
+	if (tracePtr->traceProc == proc) {
+	    return tracePtr->clientData;
+	}
+    }
+    return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_TraceCommand --
+ *
+ *	Arrange for rename/deletes to a command to cause a
+ *	procedure to be invoked, which can monitor the operations.
+ *
+ * Results:
+ *	A standard Tcl return value.
+ *
+ * Side effects:
+ *	A trace is set up on the command given by cmdName, such that
+ *	future changes to the command will be intermediated by
+ *	proc.  See the manual entry for complete details on the calling
+ *	sequence for proc.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_TraceCommand(interp, cmdName, flags, proc, clientData)
+    Tcl_Interp *interp;		/* Interpreter in which command is
+				 * to be traced. */
+    char *cmdName;		/* Name of command. */
+    int flags;			/* OR-ed collection of bits, including any
+				 * of TCL_TRACE_RENAME, TCL_TRACE_DELETE. */
+    Tcl_CommandTraceProc *proc;	/* Procedure to call when specified ops are
+				 * invoked upon varName. */
+    ClientData clientData;	/* Arbitrary argument to pass to proc. */
+{
+    Command *cmdPtr;
+    register CommandTrace *tracePtr;
+
+    cmdPtr = (Command*)Tcl_FindCommand(interp, cmdName,
+	    NULL, TCL_LEAVE_ERR_MSG);
+    if (cmdPtr == NULL) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Set up trace information.
+     */
+
+    tracePtr = (CommandTrace *) ckalloc(sizeof(CommandTrace));
+    tracePtr->traceProc = proc;
+    tracePtr->clientData = clientData;
+    tracePtr->flags = flags & (TCL_TRACE_RENAME | TCL_TRACE_DELETE);
+    tracePtr->nextPtr = cmdPtr->tracePtr;
+    cmdPtr->tracePtr = tracePtr;
     return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_UntraceCommand --
+ *
+ *	Remove a previously-created trace for a command.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	If there exists a trace for the command given by cmdName
+ *	with the given flags, proc, and clientData, then that trace
+ *	is removed.
+ *
+ *----------------------------------------------------------------------
+ */
 
-    badOps:
-    Tcl_AppendResult(interp, "bad operations \"", rwuOps,
-	    "\": should be one or more of rwu", (char *) NULL);
-    return TCL_ERROR;
+void
+Tcl_UntraceCommand(interp, cmdName, flags, proc, clientData)
+    Tcl_Interp *interp;		/* Interpreter containing command. */
+    char *cmdName;		/* Name of command. */
+    int flags;			/* OR-ed collection of bits, including any
+				 * of TCL_TRACE_RENAME, TCL_TRACE_DELETE. */
+    Tcl_CommandTraceProc *proc;	/* Procedure assocated with trace. */
+    ClientData clientData;	/* Arbitrary argument to pass to proc. */
+{
+    register CommandTrace *tracePtr;
+    CommandTrace *prevPtr;
+    Command *cmdPtr;
+    Interp *iPtr = (Interp *) interp;
+    ActiveCommandTrace *activePtr;
+
+    cmdPtr = (Command*)Tcl_FindCommand(interp, cmdName, 
+		NULL, TCL_LEAVE_ERR_MSG);
+    if (cmdPtr == NULL) {
+	return;
+    }
+
+    flags &= (TCL_TRACE_RENAME | TCL_TRACE_DELETE);
+    for (tracePtr = cmdPtr->tracePtr, prevPtr = NULL;  ;
+	 prevPtr = tracePtr, tracePtr = tracePtr->nextPtr) {
+	if (tracePtr == NULL) {
+	    return;
+	}
+	if ((tracePtr->traceProc == proc) && (tracePtr->flags == flags)
+		&& (tracePtr->clientData == clientData)) {
+	    break;
+	}
+    }
+
+    /*
+     * The code below makes it possible to delete traces while traces
+     * are active: it makes sure that the deleted trace won't be
+     * processed by CallTraces.
+     */
+
+    for (activePtr = iPtr->activeCmdTracePtr;  activePtr != NULL;
+	 activePtr = activePtr->nextPtr) {
+	if (activePtr->nextTracePtr == tracePtr) {
+	    activePtr->nextTracePtr = tracePtr->nextPtr;
+	}
+    }
+    if (prevPtr == NULL) {
+	cmdPtr->tracePtr = tracePtr->nextPtr;
+    } else {
+	prevPtr->nextPtr = tracePtr->nextPtr;
+    }
+    ckfree((char *) tracePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TraceCommandProc --
+ *
+ *	This procedure is called to handle command changes that have
+ *	been traced using the "trace" command.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Depends on the command associated with the trace.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+static void
+TraceCommandProc(clientData, interp, oldName, newName, flags)
+    ClientData clientData;	/* Information about the command trace. */
+    Tcl_Interp *interp;		/* Interpreter containing command. */
+    char *oldName;		/* Name of command being changed. */
+    char *newName;		/* New name of command.  Empty string
+                  		 * or NULL means command is being deleted
+                  		 * (renamed to ""). */
+    int flags;			/* OR-ed bits giving operation and other
+				 * information. */
+{
+    Tcl_SavedResult state;
+    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) clientData;
+    int code;
+    Tcl_DString cmd;
+
+    if (tcmdPtr->errMsg != NULL) {
+	ckfree(tcmdPtr->errMsg);
+	tcmdPtr->errMsg = NULL;
+    }
+    if ((tcmdPtr->flags & flags) && !(flags & TCL_INTERP_DESTROYED)) {
+	/*
+	 * Generate a command to execute by appending list elements
+	 * for the old and new command name and the operation.
+	 */
+
+	if (newName == NULL) {
+	    newName = "";
+	}
+	Tcl_DStringInit(&cmd);
+	Tcl_DStringAppend(&cmd, tcmdPtr->command, (int) tcmdPtr->length);
+	Tcl_DStringAppendElement(&cmd, oldName);
+	Tcl_DStringAppendElement(&cmd, newName);
+	if (flags & TCL_TRACE_RENAME) {
+	    Tcl_DStringAppend(&cmd, " rename", 7);
+	} else if (flags & TCL_TRACE_DELETE) {
+	    Tcl_DStringAppend(&cmd, " delete", 7);
+	}
+
+	/*
+	 * Execute the command.  Save the interp's result used for
+	 * the command. We discard any object result the command returns.
+	 */
+
+	Tcl_SaveResult(interp, &state);
+
+	code = Tcl_Eval(interp, Tcl_DStringValue(&cmd));
+	if (code != TCL_OK) {	     
+	    /* We ignore errors in these traced commands */
+	}
+
+	Tcl_RestoreResult(interp, &state);
+
+	Tcl_DStringFree(&cmd);
+    }
+    if (flags & TCL_TRACE_DESTROYED) {
+	if (tcmdPtr->errMsg != NULL) {
+	    ckfree(tcmdPtr->errMsg);
+	}
+	ckfree((char *) tcmdPtr);
+    }
+    return;
 }
 
 /*
@@ -2706,50 +3410,67 @@ TraceVarProc(clientData, interp, name1, name2, flags)
 	tvarPtr->errMsg = NULL;
     }
     if ((tvarPtr->flags & flags) && !(flags & TCL_INTERP_DESTROYED)) {
+	if (tvarPtr->length != (size_t) 0) {
+	    /*
+	     * Generate a command to execute by appending list elements
+	     * for the two variable names and the operation. 
+	     */
 
-	/*
-	 * Generate a command to execute by appending list elements
-	 * for the two variable names and the operation.  The five
-	 * extra characters are for three space, the opcode character,
-	 * and the terminating null.
-	 */
+	    if (name2 == NULL) {
+		name2 = "";
+	    }
+	    Tcl_DStringInit(&cmd);
+	    Tcl_DStringAppend(&cmd, tvarPtr->command, (int) tvarPtr->length);
+	    Tcl_DStringAppendElement(&cmd, name1);
+	    Tcl_DStringAppendElement(&cmd, name2);
+#ifndef TCL_REMOVE_OBSOLETE_TRACES
+	    if (tvarPtr->flags & TCL_TRACE_OLD_STYLE) {
+		if (flags & TCL_TRACE_ARRAY) {
+		    Tcl_DStringAppend(&cmd, " a", 2);
+		} else if (flags & TCL_TRACE_READS) {
+		    Tcl_DStringAppend(&cmd, " r", 2);
+		} else if (flags & TCL_TRACE_WRITES) {
+		    Tcl_DStringAppend(&cmd, " w", 2);
+		} else if (flags & TCL_TRACE_UNSETS) {
+		    Tcl_DStringAppend(&cmd, " u", 2);
+		}
+	    } else {
+#endif
+		if (flags & TCL_TRACE_ARRAY) {
+		    Tcl_DStringAppend(&cmd, " array", 6);
+		} else if (flags & TCL_TRACE_READS) {
+		    Tcl_DStringAppend(&cmd, " read", 5);
+		} else if (flags & TCL_TRACE_WRITES) {
+		    Tcl_DStringAppend(&cmd, " write", 6);
+		} else if (flags & TCL_TRACE_UNSETS) {
+		    Tcl_DStringAppend(&cmd, " unset", 6);
+		}
+#ifndef TCL_REMOVE_OBSOLETE_TRACES
+	    }
+#endif
+	    
+	    /*
+	     * Execute the command.  Save the interp's result used for
+	     * the command. We discard any object result the command returns.
+	     */
 
-	if (name2 == NULL) {
-	    name2 = "";
-	}
-	Tcl_DStringInit(&cmd);
-	Tcl_DStringAppend(&cmd, tvarPtr->command, (int) tvarPtr->length);
-	Tcl_DStringAppendElement(&cmd, name1);
-	Tcl_DStringAppendElement(&cmd, name2);
-	if (flags & TCL_TRACE_READS) {
-	    Tcl_DStringAppend(&cmd, " r", 2);
-	} else if (flags & TCL_TRACE_WRITES) {
-	    Tcl_DStringAppend(&cmd, " w", 2);
-	} else if (flags & TCL_TRACE_UNSETS) {
-	    Tcl_DStringAppend(&cmd, " u", 2);
-	}
+	    Tcl_SaveResult(interp, &state);
 
-	/*
-	 * Execute the command.  Save the interp's result used for
-	 * the command. We discard any object result the command returns.
-	 */
+	    code = Tcl_Eval(interp, Tcl_DStringValue(&cmd));
+	    if (code != TCL_OK) {	     /* copy error msg to result */
+		char *string;
+		int length;
+		
+		string = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &length);
+		tvarPtr->errMsg = (char *) ckalloc((unsigned) (length + 1));
+		memcpy(tvarPtr->errMsg, string, (size_t) (length + 1));
+		result = tvarPtr->errMsg;
+	    }
 
-	Tcl_SaveResult(interp, &state);
+	    Tcl_RestoreResult(interp, &state);
 
-	code = Tcl_Eval(interp, Tcl_DStringValue(&cmd));
-	if (code != TCL_OK) {	     /* copy error msg to result */
-	    char *string;
-	    int length;
-	    
-	    string = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &length);
-	    tvarPtr->errMsg = (char *) ckalloc((unsigned) (length + 1));
-	    memcpy(tvarPtr->errMsg, string, (size_t) (length + 1));
-	    result = tvarPtr->errMsg;
+	    Tcl_DStringFree(&cmd);
 	}
-
-	Tcl_RestoreResult(interp, &state);
-
-	Tcl_DStringFree(&cmd);
     }
     if (flags & TCL_TRACE_DESTROYED) {
 	result = NULL;
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index 8b041c7..fd355df 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -8,7 +8,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclDecls.h,v 1.39 2000/07/22 01:53:24 ericm Exp $
+ * RCS: @(#) $Id: tclDecls.h,v 1.40 2000/08/25 02:04:28 ericm Exp $
  */
 
 #ifndef _TCLDECLS
@@ -1268,6 +1268,21 @@ EXTERN void		Tcl_InitHashTableEx _ANSI_ARGS_((
 /* 406 */
 EXTERN void		Tcl_InitObjHashTable _ANSI_ARGS_((
 				Tcl_HashTable * tablePtr));
+/* 407 */
+EXTERN ClientData	Tcl_CommandTraceInfo _ANSI_ARGS_((
+				Tcl_Interp * interp, char * varName, 
+				int flags, Tcl_CommandTraceProc * procPtr, 
+				ClientData prevClientData));
+/* 408 */
+EXTERN int		Tcl_TraceCommand _ANSI_ARGS_((Tcl_Interp * interp, 
+				char * varName, int flags, 
+				Tcl_CommandTraceProc * proc, 
+				ClientData clientData));
+/* 409 */
+EXTERN void		Tcl_UntraceCommand _ANSI_ARGS_((Tcl_Interp * interp, 
+				char * varName, int flags, 
+				Tcl_CommandTraceProc * proc, 
+				ClientData clientData));
 
 typedef struct TclStubHooks {
     struct TclPlatStubs *tclPlatStubs;
@@ -1742,6 +1757,9 @@ typedef struct TclStubs {
     Tcl_HashEntry * (*tcl_CreateHashEntry) _ANSI_ARGS_((Tcl_HashTable * tablePtr, CONST char * key, int * newPtr)); /* 404 */
     void (*tcl_InitHashTableEx) _ANSI_ARGS_((Tcl_HashTable * tablePtr, int keyType, Tcl_HashKeyType * typePtr)); /* 405 */
     void (*tcl_InitObjHashTable) _ANSI_ARGS_((Tcl_HashTable * tablePtr)); /* 406 */
+    ClientData (*tcl_CommandTraceInfo) _ANSI_ARGS_((Tcl_Interp * interp, char * varName, int flags, Tcl_CommandTraceProc * procPtr, ClientData prevClientData)); /* 407 */
+    int (*tcl_TraceCommand) _ANSI_ARGS_((Tcl_Interp * interp, char * varName, int flags, Tcl_CommandTraceProc * proc, ClientData clientData)); /* 408 */
+    void (*tcl_UntraceCommand) _ANSI_ARGS_((Tcl_Interp * interp, char * varName, int flags, Tcl_CommandTraceProc * proc, ClientData clientData)); /* 409 */
 } TclStubs;
 
 #ifdef __cplusplus
@@ -3415,6 +3433,18 @@ extern TclStubs *tclStubsPtr;
 #define Tcl_InitObjHashTable \
 	(tclStubsPtr->tcl_InitObjHashTable) /* 406 */
 #endif
+#ifndef Tcl_CommandTraceInfo
+#define Tcl_CommandTraceInfo \
+	(tclStubsPtr->tcl_CommandTraceInfo) /* 407 */
+#endif
+#ifndef Tcl_TraceCommand
+#define Tcl_TraceCommand \
+	(tclStubsPtr->tcl_TraceCommand) /* 408 */
+#endif
+#ifndef Tcl_UntraceCommand
+#define Tcl_UntraceCommand \
+	(tclStubsPtr->tcl_UntraceCommand) /* 409 */
+#endif
 
 #endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
 
diff --git a/generic/tclInt.h b/generic/tclInt.h
index bb3e32d..c4858d4 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -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: tclInt.h,v 1.49 2000/08/10 18:25:15 davidg Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.50 2000/08/25 02:04:29 ericm Exp $
  */
 
 #ifndef _TCLINT
@@ -270,6 +270,35 @@ typedef struct VarTrace {
 } VarTrace;
 
 /*
+ * The following structure defines a command trace, which is used to
+ * invoke a specific C procedure whenever certain operations are performed
+ * on a command.
+ */
+
+typedef struct CommandTrace {
+    Tcl_CommandTraceProc *traceProc;/* Procedure to call when operations given
+				     * by flags are performed on command. */
+    ClientData clientData;	    /* Argument to pass to proc. */
+    int flags;			    /* What events the trace procedure is
+				     * interested in:  OR-ed combination of
+				     * TCL_TRACE_RENAME, TCL_TRACE_DELETE. */
+    struct CommandTrace *nextPtr;   /* Next in list of traces associated with
+				     * a particular command. */
+} CommandTrace;
+
+typedef struct ActiveCommandTrace {
+    struct Command *cmdPtr;	/* Variable that's being traced. */
+    struct ActiveCommandTrace *nextPtr;
+				/* Next in list of all active variable
+				 * traces for the interpreter, or NULL
+				 * if no more. */
+    CommandTrace *nextTracePtr;	/* Next trace to check after current
+				 * trace procedure returns;  if this
+				 * trace gets deleted, must update pointer
+				 * to avoid using free'd memory. */
+} ActiveCommandTrace;
+
+/*
  * When a variable trace is active (i.e. its associated procedure is
  * executing), one of the following structures is linked into a list
  * associated with the variable's interpreter.	The information in
@@ -1020,10 +1049,8 @@ typedef struct Command {
 				/* Procedure invoked when deleting command
 				 * to, e.g., free all client data. */
     ClientData deleteData;	/* Arbitrary value passed to deleteProc. */
-    int deleted;		/* Means that the command is in the process
-				 * of being deleted (its deleteProc is
-				 * currently executing). Other attempts to
-				 * delete the command should be ignored. */
+    int flags;			/* Miscellaneous bits of information about
+				 * command. See below for definitions. */
     ImportRef *importRefPtr;	/* List of each imported Command created in
 				 * another namespace when this command is
 				 * imported. These imported commands
@@ -1031,9 +1058,31 @@ typedef struct Command {
 				 * command. The list is used to remove all
 				 * those imported commands when deleting
 				 * this "real" command. */
+    CommandTrace *tracePtr;	/* First in list of all traces set for this
+				 * command. */
 } Command;
 
 /*
+ * Flag bits for commands. 
+ *
+ * CMD_IS_DELETED -		Means that the command is in the process
+ *                              of being deleted (its deleteProc is
+ *                              currently executing). Other attempts to
+ *                              delete the command should be ignored.
+ * CMD_TRACE_ACTIVE -		1 means that trace processing is currently
+ *				underway for a rename/delete change.
+ *				See the two flags below for which is
+ *				currently being processed.
+ * TCL_TRACE_RENAME -           A rename trace is in progress. Further
+ *                              recursive renames will not be traced.
+ * TCL_TRACE_DELETE -           A delete trace is in progress. Further 
+ *                              recursive deletes will not be traced.
+ * (these last two flags are defined in tcl.h)
+ */
+#define CMD_IS_DELETED		0x1
+#define CMD_TRACE_ACTIVE	0x2
+
+/*
  *----------------------------------------------------------------
  * Data structures related to name resolution procedures.
  *----------------------------------------------------------------
@@ -1248,6 +1297,9 @@ typedef struct Interp {
 				 * accessed directly; see comment above. */
     Tcl_ThreadId threadId;	/* ID of thread that owns the interpreter */
 
+    ActiveCommandTrace *activeCmdTracePtr;
+				/* First in list of active command traces for
+				 * interp, or NULL if no active traces. */
     /*
      * Statistical information about the bytecode compiler and interpreter's
      * operation.
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 7a76c9b..c927969 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -8,7 +8,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclStubInit.c,v 1.42 2000/07/26 01:30:59 davidg Exp $
+ * RCS: @(#) $Id: tclStubInit.c,v 1.43 2000/08/25 02:04:29 ericm Exp $
  */
 
 #include "tclInt.h"
@@ -809,6 +809,9 @@ TclStubs tclStubs = {
     Tcl_CreateHashEntry, /* 404 */
     Tcl_InitHashTableEx, /* 405 */
     Tcl_InitObjHashTable, /* 406 */
+    Tcl_CommandTraceInfo, /* 407 */
+    Tcl_TraceCommand, /* 408 */
+    Tcl_UntraceCommand, /* 409 */
 };
 
 /* !END!: Do not edit above this line. */
diff --git a/generic/tclVar.c b/generic/tclVar.c
index 8e431c7..48fd89a 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -14,7 +14,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclVar.c,v 1.21 2000/08/21 01:37:51 ericm Exp $
+ * RCS: @(#) $Id: tclVar.c,v 1.22 2000/08/25 02:04:29 ericm Exp $
  */
 
 #include "tclInt.h"
@@ -2309,8 +2309,17 @@ Tcl_TraceVar2(interp, part1, part2, flags, proc, clientData)
 {
     Var *varPtr, *arrayPtr;
     register VarTrace *tracePtr;
-
-    varPtr = TclLookupVar(interp, part1, part2, (flags | TCL_LEAVE_ERR_MSG),
+    int flagMask;
+    
+    /* 
+     * We strip 'flags' down to just the parts which are relevant to
+     * TclLookupVar, to avoid conflicts between trace flags and
+     * internal namespace flags such as 'FIND_ONLY_NS'.  This can
+     * now occur since we have trace flags with values 0x1000 and higher.
+     */
+    flagMask = TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY;
+    varPtr = TclLookupVar(interp, part1, part2,
+	    (flags & flagMask) | TCL_LEAVE_ERR_MSG,
 	    "trace", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
     if (varPtr == NULL) {
 	return TCL_ERROR;
@@ -2320,14 +2329,17 @@ Tcl_TraceVar2(interp, part1, part2, flags, proc, clientData)
      * Set up trace information.
      */
 
-    tracePtr = (VarTrace *) ckalloc(sizeof(VarTrace));
-    tracePtr->traceProc = proc;
-    tracePtr->clientData = clientData;
-    tracePtr->flags = 
-	flags & (TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS | 
+    flagMask = (TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS | 
 		TCL_TRACE_ARRAY);
-    tracePtr->nextPtr = varPtr->tracePtr;
-    varPtr->tracePtr = tracePtr;
+#ifndef TCL_REMOVE_OBSOLETE_TRACES
+    flagMask |= TCL_TRACE_OLD_STYLE;
+#endif
+    tracePtr = (VarTrace *) ckalloc(sizeof(VarTrace));
+    tracePtr->traceProc		= proc;
+    tracePtr->clientData	= clientData;
+    tracePtr->flags		= flags & flagMask;
+    tracePtr->nextPtr		= varPtr->tracePtr;
+    varPtr->tracePtr		= tracePtr;
     return TCL_OK;
 }
 
@@ -2403,17 +2415,31 @@ Tcl_UntraceVar2(interp, part1, part2, flags, proc, clientData)
     Var *varPtr, *arrayPtr;
     Interp *iPtr = (Interp *) interp;
     ActiveVarTrace *activePtr;
-
-    varPtr = TclLookupVar(interp, part1, part2,
-	    flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY),
+    int flagMask;
+    
+    /*
+     * Set up a mask to mask out the parts of the flags that we are not
+     * interested in now.
+     */
+    flagMask = TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY;
+    varPtr = TclLookupVar(interp, part1, part2, flags & flagMask,
 	    /*msg*/ (char *) NULL,
 	    /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
     if (varPtr == NULL) {
 	return;
     }
 
-    flags &= (TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS |
-	    TCL_TRACE_ARRAY);
+
+    /*
+     * Set up a mask to mask out the parts of the flags that we are not
+     * interested in now.
+     */
+    flagMask = TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS |
+	TCL_TRACE_ARRAY; 
+#ifndef TCL_REMOVE_OBSOLETE_TRACES
+    flagMask |= TCL_TRACE_OLD_STYLE;
+#endif
+    flags &= flagMask;
     for (tracePtr = varPtr->tracePtr, prevPtr = NULL;  ;
 	 prevPtr = tracePtr, tracePtr = tracePtr->nextPtr) {
 	if (tracePtr == NULL) {