* 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).
author: ericm <ericm> 2000-08-25 02:04:26 (GMT)
committer: ericm <ericm> 2000-08-25 02:04:26 (GMT)
commit: 5264f0bed54365470c89b67b7b18851776a0ceb1 (patch)
tree: a3a8e43d27bbf411eb0d9049598838a1c25f3b8b
parent: 4c6c508ce30845f9e15d7d5f1db2821a92c7a157 (diff)
download: tcl-5264f0bed54365470c89b67b7b18851776a0ceb1.zip
tcl-5264f0bed54365470c89b67b7b18851776a0ceb1.tar.gz
tcl-5264f0bed54365470c89b67b7b18851776a0ceb1.tar.bz2
11 files changed, 1921 insertions, 493 deletions
diff --git a/ChangeLog b/ChangeLog
index 681a398..f1dc1ac 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,34 @@
+2000-08-24  Eric Melski  <ericm@ajubasolutions.com>
+
+	Overall change:  Added support for command rename/delete traces
+	and new trace syntax, from patch from Vince Darley.  Added support
+	for array traces for variables.
+
+	* 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).
+	
 2000-08-20  Eric Melski  <ericm@ajubasolutions.com>
 
 	* generic/tclVar.c: Added check for non-arrays for [array statistics]
diff --git a/doc/trace.n b/doc/trace.n
index 7266bac..bf04299 100644
--- a/doc/trace.n
+++ b/doc/trace.n
@@ -5,14 +5,14 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" RCS: @(#) $Id: trace.n,v 1.3 2000/01/26 21:36:35 ericm Exp $
+'\" RCS: @(#) $Id: trace.n,v 1.4 2000/08/25 02:04:27 ericm Exp $
 '\" 
 .so man.macros
-.TH trace n "" Tcl "Tcl Built-In Commands"
+.TH trace n "8.4" Tcl "Tcl Built-In Commands"
 .BS
 '\" Note:  do not modify the .SH NAME line immediately below!
 .SH NAME
-trace \- Monitor variable accesses
+trace \- Monitor variable accesses and command usages
 .SH SYNOPSIS
 \fBtrace \fIoption\fR ?\fIarg arg ...\fR?
 .BE
@@ -20,12 +20,55 @@ trace \- Monitor variable accesses
 .SH DESCRIPTION
 .PP
 This command causes Tcl commands to be executed whenever certain operations are
-invoked.  At present, only variable tracing is implemented. The
-legal \fIoption\fR's (which may be abbreviated) are:
+invoked.  The legal \fIoption\fR's (which may be abbreviated) are:
 .TP
-\fBtrace variable \fIname ops command\fR
+\fBtrace add \fItype name ops ?args?\fR
+Where \fItype\fR is \fBcommand\fR, or \fBvariable\fR.
+.RS
+.TP
+\fBtrace add command\fR \fIname ops command\fR
+Arrange for \fIcommand\fR to be executed whenever command \fIname\fR
+is modified in one of the ways given by the list \fIops\fR.  \fIName\fR will be
+resolved using the usual namespace resolution rules used by
+procedures.  If the command does not exist, an error will be thrown.
+.RS
+.PP
+\fIOps\fR indicates which operations are of interest, and is a list of
+one or more of the following items:
+.TP
+\fBrename\fR
+Invoke \fIcommand\fR whenever the command is renamed.  Note that
+renaming to the empty string is considered deletion, and will not
+be traced with '\fBrename\fR'.
+.TP
+\fBdelete\fR
+Invoke \fIcommand\fR when the command is deleted.  Commands can be
+deleted explicitly by using the \fBrename\fR command to rename the
+command to an empty string.  Commands are also deleted when the
+interpreter is deleted, but traces will not be invoked because there is no
+interpreter in which to execute them.
+.PP
+When the trace triggers, three arguments are appended to
+\fIcommand\fR so that the actual command is as follows:
+.CS
+\fIcommand oldName newName op\fR
+.CE
+\fIOldName\fR and \fInewName\fR give the traced command's current
+(old) namename, and the name to which it is being renamed (the empty
+string if this is a 'delete' operation).
+\fIOp\fR indicates what operation is being performed on the
+variable, and is one of \fBrename\fR or \fBdelete\fR as
+defined above.  The trace operation cannot be used to stop a command
+from being deleted.  Tcl will always remove the command once the trace
+is complete.  Recursive renaming or deleting will not cause further traces 
+of the same type to be evaluated, so a delete trace which itself
+deletes the command, or a rename trace which itself renames the
+command will not cause further trace evaluations to occur.
+.RE
+.TP
+\fBtrace add variable\fI name ops command\fR
 Arrange for \fIcommand\fR to be executed whenever variable \fIname\fR
-is accessed in one of the ways given by \fIops\fR.  \fIName\fR may
+is accessed in one of the ways given by the list \fIops\fR.  \fIName\fR may
 refer to a normal variable, an element of an array, or to an array
 as a whole (i.e. \fIname\fR may be just the name of an array, with no
 parenthesized index).  If \fIname\fR refers to a whole array, then
@@ -35,16 +78,19 @@ will not be given a value, so it will be visible to \fBnamespace which\fR
 queries, but not to \fBinfo exists\fR queries.
 .RS
 .PP
-\fIOps\fR indicates which operations are of interest, and consists of
-one or more of the following letters:
+\fIOps\fR indicates which operations are of interest, and is a list of
+one or more of the following items:
 .TP
-\fBr\fR
+\fBarray\fR
+Invoke \fIcommand\fR whenever the variable is accessed or modified via
+the \fBarray\fR command.
+\fBread\fR
 Invoke \fIcommand\fR whenever the variable is read.
 .TP
-\fBw\fR
+\fBwrite\fR
 Invoke \fIcommand\fR whenever the variable is written.
 .TP
-\fBu\fR
+\fBunset\fR
 Invoke \fIcommand\fR whenever the variable is unset.  Variables
 can be unset explicitly with the \fBunset\fR command, or
 implicitly when procedures return (all of their local variables
@@ -70,91 +116,124 @@ name used in the \fBtrace variable\fR command:  the \fBupvar\fR
 command allows a procedure to reference a variable under a
 different name.
 \fIOp\fR indicates what operation is being performed on the
-variable, and is one of \fBr\fR, \fBw\fR, or \fBu\fR as
+variable, and is one of \fBread\fR, \fBwrite\fR, or \fBunset\fR as
 defined above.
 .PP
 \fICommand\fR executes in the same context as the code that invoked
-the traced operation:  if the variable was accessed as part of a
-Tcl procedure, then \fIcommand\fR will have access to the same
-local variables as code in the procedure.  This context may be
-different than the context in which the trace was created.
-If \fIcommand\fR invokes a procedure (which it normally does) then
-the procedure will have to use \fBupvar\fR or \fBuplevel\fR if it
-wishes to access the traced variable.
-Note also that \fIname1\fR may not necessarily be the same as the name
-used to set the trace on the variable;  differences can occur if
-the access is made through a variable defined with the \fBupvar\fR
-command.
+the traced operation:  if the variable was accessed as part of a Tcl
+procedure, then \fIcommand\fR will have access to the same local
+variables as code in the procedure.  This context may be different
+than the context in which the trace was created. If \fIcommand\fR
+invokes a procedure (which it normally does) then the procedure will
+have to use \fBupvar\fR or \fBuplevel\fR if it wishes to access the
+traced variable.  Note also that \fIname1\fR may not necessarily be
+the same as the name used to set the trace on the variable;
+differences can occur if the access is made through a variable defined
+with the \fBupvar\fR command.
 .PP
-For read and write traces, \fIcommand\fR can modify
-the variable to affect the result of the traced operation.
-If \fIcommand\fR modifies the value of a variable during a
-read or write trace, then the new value will be returned as the
-result of the traced operation.
-The return value from  \fIcommand\fR is ignored except that
-if it returns an error of any sort then the traced operation
-also returns an error with
-the same error message returned by the trace command
-(this mechanism can be used to implement read-only variables, for
-example).
-For write traces, \fIcommand\fR is invoked after the variable's
-value has been changed; it can write a new value into the variable
-to override the original value specified in the write operation.
-To implement read-only variables, \fIcommand\fR will have to restore
-the old value of the variable.
+For read and write traces, \fIcommand\fR can modify the variable to
+affect the result of the traced operation.  If \fIcommand\fR modifies
+the value of a variable during a read or write trace, then the new
+value will be returned as the result of the traced operation.  The
+return value from  \fIcommand\fR is ignored except that if it returns
+an error of any sort then the traced operation also returns an error
+with the same error message returned by the trace command (this
+mechanism can be used to implement read-only variables, for example).
+For write traces, \fIcommand\fR is invoked after the variable's value
+has been changed; it can write a new value into the variable to
+override the original value specified in the write operation.  To
+implement read-only variables, \fIcommand\fR will have to restore the
+old value of the variable.
 .PP
 While \fIcommand\fR is executing during a read or write trace, traces
-on the variable are temporarily disabled.
-This means that reads and writes invoked by
-\fIcommand\fR will occur directly, without invoking \fIcommand\fR
-(or any other traces) again.
-However, if \fIcommand\fR unsets the variable then unset traces
-will be invoked.
+on the variable are temporarily disabled.  This means that reads and
+writes invoked by \fIcommand\fR will occur directly, without invoking
+\fIcommand\fR (or any other traces) again.  However, if \fIcommand\fR
+unsets the variable then unset traces will be invoked.
 .PP
-When an unset trace is invoked, the variable has already been
-deleted:  it will appear to be undefined with no traces.
-If an unset occurs because of a procedure return, then the
-trace will be invoked in the variable context of the procedure
-being returned to:  the stack frame of the returning procedure
-will no longer exist.
-Traces are not disabled during unset traces, so if an unset trace
-command creates a new trace and accesses the variable, the
-trace will be invoked.
-Any errors in unset traces are ignored.
+When an unset trace is invoked, the variable has already been deleted:
+it will appear to be undefined with no traces.  If an unset occurs
+because of a procedure return, then the trace will be invoked in the
+variable context of the procedure being returned to:  the stack frame
+of the returning procedure will no longer exist.  Traces are not
+disabled during unset traces, so if an unset trace command creates a
+new trace and accesses the variable, the trace will be invoked.  Any
+errors in unset traces are ignored.
 .PP
-If there are multiple traces on a variable they are invoked
-in order of creation, most-recent first.
-If one trace returns an error, then no further traces are
-invoked for the variable.
-If an array element has a trace set, and there is also a trace
-set on the array as a whole, the trace on the overall array
-is invoked before the one on the element.
+If there are multiple traces on a variable they are invoked in order
+of creation, most-recent first.  If one trace returns an error, then
+no further traces are invoked for the variable.  If an array element
+has a trace set, and there is also a trace set on the array as a
+whole, the trace on the overall array is invoked before the one on the
+element.
 .PP
-Once created, the trace remains in effect either until the
-trace is removed with the \fBtrace vdelete\fR command described
-below, until the variable is unset, or until the interpreter
-is deleted.
-Unsetting an element of array will remove any traces on that
-element, but will not remove traces on the overall array.
+Once created, the trace remains in effect either until the trace is
+removed with the \fBtrace remove variable\fR command described below,
+until the variable is unset, or until the interpreter is deleted.
+Unsetting an element of array will remove any traces on that element,
+but will not remove traces on the overall array.
 .PP
 This command returns an empty string.
 .RE
 .TP
+\fBtrace remove \fItype name opList command\fR
+Where \fItype\fR is either \fBcommand\fR or \fBvariable\fR.
+.RS
+.TP
+\fBtrace remove command\fI name opList command\fR
+If there is a trace set on command \fIname\fR with the operations and
+command given by \fIopList\fR and \fIcommand\fR, then the trace is
+removed, so that \fIcommand\fR will never again be invoked.  Returns
+an empty string.   If \fIname\fR doesn't exist, the command will throw
+an error.
+.TP
+\fBtrace remove variable\fI name opList command\fR
+If there is a trace set on variable \fIname\fR with the operations and
+command given by \fIopList\fR and \fIcommand\fR, then the trace is
+removed, so that \fIcommand\fR will never again be invoked.  Returns
+an empty string.
+.RE
+.TP
+\fBtrace list \fItype name\fR
+Where \fItype\fR is either \fBcommand\fR or \fBvariable\fR.
+.RS
+.TP
+\fBtrace list command\fI name\fR
+Returns a list containing one element for each trace currently set on
+command \fIname\fR. Each element of the list is itself a list
+containing two elements, which are the \fIopList\fR and \fIcommand\fR
+associated with the trace.  If \fIname\fR doesn't have any traces set,
+then the result of the command will be an empty string.  If \fIname\fR
+doesn't exist, the command will throw an error.
+.TP
+\fBtrace list variable\fI name\fR
+Returns a list containing one element for each trace currently set on
+variable \fIname\fR.  Each element of the list is itself a list
+containing two elements, which are the \fIopList\fR and \fIcommand\fR
+associated with the trace.  If \fIname\fR doesn't exist or doesn't
+have any traces set, then the result of the command will be an empty
+string.
+.RE
+.PP
+For backwards compatibility, three other subcommands are available:
+.RS
+.TP
+\fBtrace variable \fIname ops command\fR
+This is equivalent to \fBtrace add variable \fIname ops command\fR.
+.TP
 \fBtrace vdelete \fIname ops command\fR
-If there is a trace set on variable \fIname\fR with the
-operations and command given by \fIops\fR and \fIcommand\fR,
-then the trace is removed, so that \fIcommand\fR will never
-again be invoked.
-Returns an empty string.
-.TP
-\fBtrace vinfo \fIname\fR
-Returns a list containing one element for each trace
-currently set on variable \fIname\fR.
-Each element of the list is itself a list containing two
-elements, which are the \fIops\fR and \fIcommand\fR associated
-with the trace.
-If \fIname\fR doesn't exist or doesn't have any traces set, then
-the result of the command will be an empty string.
+This is equivalent to \fBtrace remove variable \fIname ops command\fR
+.TP 
+\fBtrace vinfo \fIname\fR 
+This is equivalent to \fBtrace list variable \fIname\fR
+.RE
+.PP
+These subcommands are deprecated and will likely be removed in a
+future version of Tcl.  They use an older syntax in which \fBarray\fR,
+\fBread\fR, \fBwrite\fR, \fBunset\fR are replaced by \fBa\fR, \fBr\fR,
+\fBw\fR and \fBu\fR respectively, and the \fIops\fR argument is not a
+list, but simply a string concatenation of the operations, such as
+\fBrwua\fR.
 
 .SH KEYWORDS
-read, variable, write, trace, unset
+read, command, rename, variable, write, trace, unset
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) {
diff --git a/tests/trace.test b/tests/trace.test
index f5d1d0f..11da1a9 100644
--- a/tests/trace.test
+++ b/tests/trace.test
@@ -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: trace.test,v 1.7 2000/07/31 18:03:50 ericm Exp $
+# RCS: @(#) $Id: trace.test,v 1.8 2000/08/25 02:04:29 ericm Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -52,57 +52,60 @@ proc traceCheck {cmd args} {
 proc traceCrtElement {value name1 name2 op} {
     uplevel set ${name1}($name2) $value
 }
-
+proc traceCommand {oldName newName op} {
+    global info
+    set info [list $oldName $newName $op]
+}
 # Read-tracing on variables
 
 test trace-1.1 {trace variable reads} {
     catch {unset x}
     set info {}
-    trace var x r traceScalar
+    trace add variable x read traceScalar
     list [catch {set x} msg] $msg $info
-} {1 {can't read "x": no such variable} {x {} r 1 {can't read "x": no such variable}}}
+} {1 {can't read "x": no such variable} {x {} read 1 {can't read "x": no such variable}}}
 test trace-1.2 {trace variable reads} {
     catch {unset x}
     set x 123
     set info {}
-    trace var x r traceScalar
+    trace add variable x read traceScalar
     list [catch {set x} msg] $msg $info
-} {0 123 {x {} r 0 123}}
+} {0 123 {x {} read 0 123}}
 test trace-1.3 {trace variable reads} {
     catch {unset x}
     set info {}
-    trace var x r traceScalar
+    trace add variable x read traceScalar
     set x 123
     set info
 } {}
 test trace-1.4 {trace array element reads} {
     catch {unset x}
     set info {}
-    trace var x(2) r traceArray
+    trace add variable x(2) read traceArray
     list [catch {set x(2)} msg] $msg $info
-} {1 {can't read "x(2)": no such element in array} {x 2 r 1 {can't read "x(2)": no such element in array}}}
+} {1 {can't read "x(2)": no such element in array} {x 2 read 1 {can't read "x(2)": no such element in array}}}
 test trace-1.5 {trace array element reads} {
     catch {unset x}
     set x(2) zzz
     set info {}
-    trace var x(2) r traceArray
+    trace add variable x(2) read traceArray
     list [catch {set x(2)} msg] $msg $info
-} {0 zzz {x 2 r 0 zzz}}
+} {0 zzz {x 2 read 0 zzz}}
 test trace-1.6 {trace array element reads} {
     catch {unset x}
     set info {}
-    trace variable x r traceArray2
+    trace add variable x read traceArray2
     proc p {} {
         global x
         set x(2) willi
         return $x(2)
     }
     list [catch {p} msg] $msg $info
-} {0 willi {x 2 r}}
+} {0 willi {x 2 read}}
 test trace-1.7 {trace array element reads, create element undefined if nonexistant} {
     catch {unset x}
     set info {}
-    trace variable x r q
+    trace add variable x read q
     proc q {name1 name2 op} {
         global info
         set info [list $name1 $name2 $op]
@@ -115,25 +118,25 @@ test trace-1.7 {trace array element reads, create element undefined if nonexista
         return $x(Y)
     }
     list [catch {p} msg] $msg $info
-} {0 wolf {x Y r}}
+} {0 wolf {x Y read}}
 test trace-1.8 {trace reads on whole arrays} {
     catch {unset x}
     set info {}
-    trace var x r traceArray
+    trace add variable x read traceArray
     list [catch {set x(2)} msg] $msg $info
 } {1 {can't read "x(2)": no such variable} {}}
 test trace-1.9 {trace reads on whole arrays} {
     catch {unset x}
     set x(2) zzz
     set info {}
-    trace var x r traceArray
+    trace add variable x read traceArray
     list [catch {set x(2)} msg] $msg $info
-} {0 zzz {x 2 r 0 zzz}}
+} {0 zzz {x 2 read 0 zzz}}
 test trace-1.10 {trace variable reads} {
     catch {unset x}
     set x 444
     set info {}
-    trace var x r traceScalar
+    trace add variable x read traceScalar
     unset x
     set info
 } {}
@@ -143,29 +146,29 @@ test trace-1.10 {trace variable reads} {
 test trace-2.1 {trace variable writes} {
     catch {unset x}
     set info {}
-    trace var x w traceScalar
+    trace add variable x write traceScalar
     set x 123
     set info
-} {x {} w 0 123}
+} {x {} write 0 123}
 test trace-2.2 {trace writes to array elements} {
     catch {unset x}
     set info {}
-    trace var x(33) w traceArray
+    trace add variable x(33) write traceArray
     set x(33) 444
     set info
-} {x 33 w 0 444}
+} {x 33 write 0 444}
 test trace-2.3 {trace writes on whole arrays} {
     catch {unset x}
     set info {}
-    trace var x w traceArray
+    trace add variable x write traceArray
     set x(abc) qq
     set info
-} {x abc w 0 qq}
+} {x abc write 0 qq}
 test trace-2.4 {trace variable writes} {
     catch {unset x}
     set x 1234
     set info {}
-    trace var x w traceScalar
+    trace add variable x write traceScalar
     set x
     set info
 } {}
@@ -173,7 +176,7 @@ test trace-2.5 {trace variable writes} {
     catch {unset x}
     set x 1234
     set info {}
-    trace var x w traceScalar
+    trace add variable x write traceScalar
     unset x
     set info
 } {}
@@ -186,42 +189,42 @@ test trace-2.5 {trace variable writes} {
 test trace-3.1 {trace variable read-modify-writes} {
     catch {unset x}
     set info {}
-    trace var x r traceScalarAppend
+    trace add variable x read traceScalarAppend
     append x 123
     append x 456
     lappend x 789
     set info
-} {x {} r 0 123456}
+} {x {} read 0 123456}
 test trace-3.2 {trace variable read-modify-writes} {
     catch {unset x}
     set info {}
-    trace var x rw traceScalarAppend
+    trace add variable x {read write} traceScalarAppend
     append x 123
     lappend x 456
     set info
-} {x {} w 0 123 x {} r 0 123 x {} w 0 {123 456}}
+} {x {} write 0 123 x {} read 0 123 x {} write 0 {123 456}}
 
 # Basic unset-tracing on variables
 
 test trace-4.1 {trace variable unsets} {
     catch {unset x}
     set info {}
-    trace var x u traceScalar
+    trace add variable x unset traceScalar
     catch {unset x}
     set info
-} {x {} u 1 {can't read "x": no such variable}}
+} {x {} unset 1 {can't read "x": no such variable}}
 test trace-4.2 {variable mustn't exist during unset trace} {
     catch {unset x}
     set x 1234
     set info {}
-    trace var x u traceScalar
+    trace add variable x unset traceScalar
     unset x
     set info
-} {x {} u 1 {can't read "x": no such variable}}
+} {x {} unset 1 {can't read "x": no such variable}}
 test trace-4.3 {unset traces mustn't be called during reads and writes} {
     catch {unset x}
     set info {}
-    trace var x u traceScalar
+    trace add variable x unset traceScalar
     set x 44
     set x
     set info
@@ -230,31 +233,31 @@ test trace-4.4 {trace unsets on array elements} {
     catch {unset x}
     set x(0) 18
     set info {}
-    trace var x(1) u traceArray
+    trace add variable x(1) unset traceArray
     catch {unset x(1)}
     set info
-} {x 1 u 1 {can't read "x(1)": no such element in array}}
+} {x 1 unset 1 {can't read "x(1)": no such element in array}}
 test trace-4.5 {trace unsets on array elements} {
     catch {unset x}
     set x(1) 18
     set info {}
-    trace var x(1) u traceArray
+    trace add variable x(1) unset traceArray
     unset x(1)
     set info
-} {x 1 u 1 {can't read "x(1)": no such element in array}}
+} {x 1 unset 1 {can't read "x(1)": no such element in array}}
 test trace-4.6 {trace unsets on array elements} {
     catch {unset x}
     set x(1) 18
     set info {}
-    trace var x(1) u traceArray
+    trace add variable x(1) unset traceArray
     unset x
     set info
-} {x 1 u 1 {can't read "x(1)": no such variable}}
+} {x 1 unset 1 {can't read "x(1)": no such variable}}
 test trace-4.7 {trace unsets on whole arrays} {
     catch {unset x}
     set x(1) 18
     set info {}
-    trace var x u traceProc
+    trace add variable x unset traceProc
     catch {unset x(0)}
     set info
 } {}
@@ -264,38 +267,74 @@ test trace-4.8 {trace unsets on whole arrays} {
     set x(2) 144
     set x(3) 14
     set info {}
-    trace var x u traceProc
+    trace add variable x unset traceProc
     unset x(1)
     set info
-} {x 1 u}
+} {x 1 unset}
 test trace-4.9 {trace unsets on whole arrays} {
     catch {unset x}
     set x(1) 18
     set x(2) 144
     set x(3) 14
     set info {}
-    trace var x u traceProc
+    trace add variable x unset traceProc
+    unset x
+    set info
+} {x {} unset}
+
+# Array tracing on variables
+test trace-5.1 {array traces fire on accesses via [array]} {
+    catch {unset x}
+    trace add variable x array traceArray2
+    set ::info {}
+    array set x {a 1}
+    set info
+} {x {} array}
+test trace-5.2 {array traces do not fire on normal accesses} {
+    catch {unset x}
+    trace add variable x array traceArray2
+    set ::info {}
+    set x(a) 1
+    set x(b) $x(a)
+    set info
+} {}
+test trace-5.3 {array traces outlive variable} {
+    catch {unset x}
+    trace add variable x array traceArray2
+    set ::info {}
+    set x(a) 1
     unset x
+    array set x {a 1}
     set info
-} {x {} u}
+} {}
+test trace-5.4 {array traces properly listed in trace information} {
+    catch {unset x}
+    trace add variable x array traceArray2
+    trace list variable x
+} [list [list array traceArray2]]
+test trace-5.5 {array traces properly listed in trace information} {
+    catch {unset x}
+    trace variable x a traceArray2
+    trace vinfo x
+} [list [list a traceArray2]]
 
 # Trace multiple trace types at once.
 
 test trace-5.1 {multiple ops traced at once} {
     catch {unset x}
     set info {}
-    trace var x rwu traceProc
+    trace add variable x {read write unset} traceProc
     catch {set x}
     set x 22
     set x
     set x 33
     unset x
     set info
-} {x {} r x {} w x {} r x {} w x {} u}
+} {x {} read x {} write x {} read x {} write x {} unset}
 test trace-5.2 {multiple ops traced on array element} {
     catch {unset x}
     set info {}
-    trace var x(0) rwu traceProc
+    trace add variable x(0) {read write unset} traceProc
     catch {set x(0)}
     set x(0) 22
     set x(0)
@@ -303,11 +342,11 @@ test trace-5.2 {multiple ops traced on array element} {
     unset x(0)
     unset x
     set info
-} {x 0 r x 0 w x 0 r x 0 w x 0 u}
+} {x 0 read x 0 write x 0 read x 0 write x 0 unset}
 test trace-5.3 {multiple ops traced on whole array} {
     catch {unset x}
     set info {}
-    trace var x rwu traceProc
+    trace add variable x {read write unset} traceProc
     catch {set x(0)}
     set x(0) 22
     set x(0)
@@ -315,16 +354,16 @@ test trace-5.3 {multiple ops traced on whole array} {
     unset x(0)
     unset x
     set info
-} {x 0 w x 0 r x 0 w x 0 u x {} u}
+} {x 0 write x 0 read x 0 write x 0 unset x {} unset}
 
 # Check order of invocation of traces
 
 test trace-6.1 {order of invocation of traces} {
     catch {unset x}
     set info {}
-    trace var x r "traceTag 1"
-    trace var x r "traceTag 2"
-    trace var x r "traceTag 3"
+    trace add variable x read "traceTag 1"
+    trace add variable x read "traceTag 2"
+    trace add variable x read "traceTag 3"
     catch {set x}
     set x 22
     set x
@@ -334,9 +373,9 @@ test trace-6.2 {order of invocation of traces} {
     catch {unset x}
     set x(0) 44
     set info {}
-    trace var x(0) r "traceTag 1"
-    trace var x(0) r "traceTag 2"
-    trace var x(0) r "traceTag 3"
+    trace add variable x(0) read "traceTag 1"
+    trace add variable x(0) read "traceTag 2"
+    trace add variable x(0) read "traceTag 3"
     set x(0)
     set info
 } {3 2 1}
@@ -344,12 +383,12 @@ test trace-6.3 {order of invocation of traces} {
     catch {unset x}
     set x(0) 44
     set info {}
-    trace var x(0) r "traceTag 1"
-    trace var x r "traceTag A1"
-    trace var x(0) r "traceTag 2"
-    trace var x r "traceTag A2"
-    trace var x(0) r "traceTag 3"
-    trace var x r "traceTag A3"
+    trace add variable x(0) read "traceTag 1"
+    trace add variable x read "traceTag A1"
+    trace add variable x(0) read "traceTag 2"
+    trace add variable x read "traceTag A2"
+    trace add variable x(0) read "traceTag 3"
+    trace add variable x read "traceTag A3"
     set x(0)
     set info
 } {A3 A2 A1 3 2 1}
@@ -360,47 +399,47 @@ test trace-7.1 {error returns from traces} {
     catch {unset x}
     set x 123
     set info {}
-    trace var x r "traceTag 1"
-    trace var x r traceError
+    trace add variable x read "traceTag 1"
+    trace add variable x read traceError
     list [catch {set x} msg] $msg $info
 } {1 {can't read "x": trace returned error} {}}
 test trace-7.2 {error returns from traces} {
     catch {unset x}
     set x 123
     set info {}
-    trace var x w "traceTag 1"
-    trace var x w traceError
+    trace add variable x write "traceTag 1"
+    trace add variable x write traceError
     list [catch {set x 44} msg] $msg $info
 } {1 {can't set "x": trace returned error} {}}
 test trace-7.3 {error returns from traces} {
     catch {unset x}
     set x 123
     set info {}
-    trace var x w traceError
+    trace add variable x write traceError
     list [catch {append x 44} msg] $msg $info
 } {1 {can't set "x": trace returned error} {}}
 test trace-7.4 {error returns from traces} {
     catch {unset x}
     set x 123
     set info {}
-    trace var x u "traceTag 1"
-    trace var x u traceError
+    trace add variable x unset "traceTag 1"
+    trace add variable x unset traceError
     list [catch {unset x} msg] $msg $info
 } {0 {} 1}
 test trace-7.5 {error returns from traces} {
     catch {unset x}
     set x(0) 123
     set info {}
-    trace var x(0) r "traceTag 1"
-    trace var x r "traceTag 2"
-    trace var x r traceError
-    trace var x r "traceTag 3"
+    trace add variable x(0) read "traceTag 1"
+    trace add variable x read "traceTag 2"
+    trace add variable x read traceError
+    trace add variable x read "traceTag 3"
     list [catch {set x(0)} msg] $msg $info
 } {1 {can't read "x(0)": trace returned error} 3}
 test trace-7.6 {error returns from traces} {
     catch {unset x}
     set x 123
-    trace var x u traceError
+    trace add variable x unset traceError
     list [catch {unset x} msg] $msg
 } {0 {}}
 test trace-7.7 {error returns from traces} {
@@ -409,10 +448,10 @@ test trace-7.7 {error returns from traces} {
     # when the trace is deleted.
     catch {unset x}
     set x 123
-    trace var x r traceError
+    trace add variable x read traceError
     catch {set x}
     catch {set x}
-    trace vdelete x r traceError
+    trace remove variable x read traceError
 } {}
 
 # Check to see that variables are expunged before trace
@@ -423,7 +462,7 @@ test trace-8.1 {be sure variable is unset before trace is called} {
     catch {unset x}
     set x 33
     set info {}
-    trace var x u {traceCheck {uplevel set x}}
+    trace add variable x unset {traceCheck {uplevel set x}}
     unset x
     set info
 } {1 {can't read "x": no such variable}}
@@ -431,7 +470,7 @@ test trace-8.2 {be sure variable is unset before trace is called} {
     catch {unset x}
     set x 33
     set info {}
-    trace var x u {traceCheck {uplevel set x 22}}
+    trace add variable x unset {traceCheck {uplevel set x 22}}
     unset x
     concat $info [list [catch {set x} msg] $msg]
 } {0 22 0 22}
@@ -439,7 +478,7 @@ test trace-8.3 {be sure traces are cleared before unset trace called} {
     catch {unset x}
     set x 33
     set info {}
-    trace var x u {traceCheck {uplevel trace vinfo x}}
+    trace add variable x unset {traceCheck {uplevel trace list variable x}}
     unset x
     set info
 } {0 {}}
@@ -447,16 +486,16 @@ test trace-8.4 {set new trace during unset trace} {
     catch {unset x}
     set x 33
     set info {}
-    trace var x u {traceCheck {global x; trace var x u traceProc}}
+    trace add variable x unset {traceCheck {global x; trace add variable x unset traceProc}}
     unset x
-    concat $info [trace vinfo x]
-} {0 {} {u traceProc}}
+    concat $info [trace list variable x]
+} {0 {} {unset traceProc}}
 
 test trace-9.1 {make sure array elements are unset before traces are called} {
     catch {unset x}
     set x(0) 33
     set info {}
-    trace var x(0) u {traceCheck {uplevel set x(0)}}
+    trace add variable x(0) unset {traceCheck {uplevel set x(0)}}
     unset x(0)
     set info
 } {1 {can't read "x(0)": no such element in array}}
@@ -464,7 +503,7 @@ test trace-9.2 {make sure array elements are unset before traces are called} {
     catch {unset x}
     set x(0) 33
     set info {}
-    trace var x(0) u {traceCheck {uplevel set x(0) zzz}}
+    trace add variable x(0) unset {traceCheck {uplevel set x(0) zzz}}
     unset x(0)
     concat $info [list [catch {set x(0)} msg] $msg]
 } {0 zzz 0 zzz}
@@ -472,7 +511,7 @@ test trace-9.3 {array elements are unset before traces are called} {
     catch {unset x}
     set x(0) 33
     set info {}
-    trace var x(0) u {traceCheck {global x; trace vinfo x(0)}}
+    trace add variable x(0) unset {traceCheck {global x; trace list variable x(0)}}
     unset x(0)
     set info
 } {0 {}}
@@ -480,16 +519,16 @@ test trace-9.4 {set new array element trace during unset trace} {
     catch {unset x}
     set x(0) 33
     set info {}
-    trace var x(0) u {traceCheck {uplevel {trace variable x(0) r {}}}}
+    trace add variable x(0) unset {traceCheck {uplevel {trace add variable x(0) read {}}}}
     catch {unset x(0)}
-    concat $info [trace vinfo x(0)]
-} {0 {} {r {}}}
+    concat $info [trace list variable x(0)]
+} {0 {} {read {}}}
 
 test trace-10.1 {make sure arrays are unset before traces are called} {
     catch {unset x}
     set x(0) 33
     set info {}
-    trace var x u {traceCheck {uplevel set x(0)}}
+    trace add variable x unset {traceCheck {uplevel set x(0)}}
     unset x
     set info
 } {1 {can't read "x(0)": no such variable}}
@@ -497,7 +536,7 @@ test trace-10.2 {make sure arrays are unset before traces are called} {
     catch {unset x}
     set x(y) 33
     set info {}
-    trace var x u {traceCheck {uplevel set x(y) 22}}
+    trace add variable x unset {traceCheck {uplevel set x(y) 22}}
     unset x
     concat $info [list [catch {set x(y)} msg] $msg]
 } {0 22 0 22}
@@ -505,7 +544,7 @@ test trace-10.3 {make sure arrays are unset before traces are called} {
     catch {unset x}
     set x(y) 33
     set info {}
-    trace var x u {traceCheck {uplevel array exists x}}
+    trace add variable x unset {traceCheck {uplevel array exists x}}
     unset x
     set info
 } {0 0}
@@ -513,8 +552,8 @@ test trace-10.4 {make sure arrays are unset before traces are called} {
     catch {unset x}
     set x(y) 33
     set info {}
-    set cmd {traceCheck {uplevel {trace vinfo x}}}
-    trace var x u $cmd
+    set cmd {traceCheck {uplevel {trace list variable x}}}
+    trace add variable x unset $cmd
     unset x
     set info
 } {0 {}}
@@ -522,15 +561,15 @@ test trace-10.5 {set new array trace during unset trace} {
     catch {unset x}
     set x(y) 33
     set info {}
-    trace var x u {traceCheck {global x; trace var x r {}}}
+    trace add variable x unset {traceCheck {global x; trace add variable x read {}}}
     unset x
-    concat $info [trace vinfo x]
-} {0 {} {r {}}}
+    concat $info [trace list variable x]
+} {0 {} {read {}}}
 test trace-10.6 {create scalar during array unset trace} {
     catch {unset x}
     set x(y) 33
     set info {}
-    trace var x u {traceCheck {global x; set x 44}}
+    trace add variable x unset {traceCheck {global x; set x 44}}
     unset x
     concat $info [list [catch {set x} msg] $msg]
 } {0 44 0 44}
@@ -540,52 +579,52 @@ test trace-10.6 {create scalar during array unset trace} {
 test trace-11.1 {creating array when setting variable traces} {
     catch {unset x}
     set info {}
-    trace var x(0) w traceProc
+    trace add variable x(0) write traceProc
     list [catch {set x 22} msg] $msg
 } {1 {can't set "x": variable is array}}
 test trace-11.2 {creating array when setting variable traces} {
     catch {unset x}
     set info {}
-    trace var x(0) w traceProc
+    trace add variable x(0) write traceProc
     list [catch {set x(0)} msg] $msg
 } {1 {can't read "x(0)": no such element in array}}
 test trace-11.3 {creating array when setting variable traces} {
     catch {unset x}
     set info {}
-    trace var x(0) w traceProc
+    trace add variable x(0) write traceProc
     set x(0) 22
     set info
-} {x 0 w}
+} {x 0 write}
 test trace-11.4 {creating variable when setting variable traces} {
     catch {unset x}
     set info {}
-    trace var x w traceProc
+    trace add variable x write traceProc
     list [catch {set x} msg] $msg
 } {1 {can't read "x": no such variable}}
 test trace-11.5 {creating variable when setting variable traces} {
     catch {unset x}
     set info {}
-    trace var x w traceProc
+    trace add variable x write traceProc
     set x 22
     set info
-} {x {} w}
+} {x {} write}
 test trace-11.6 {creating variable when setting variable traces} {
     catch {unset x}
     set info {}
-    trace var x w traceProc
+    trace add variable x write traceProc
     set x(0) 22
     set info
-} {x 0 w}
+} {x 0 write}
 test trace-11.7 {create array element during read trace} {
     catch {unset x}
     set x(2) zzz
-    trace var x r {traceCrtElement xyzzy}
+    trace add variable x read {traceCrtElement xyzzy}
     list [catch {set x(3)} msg] $msg
 } {0 xyzzy}
 test trace-11.8 {errors when setting variable traces} {
     catch {unset x}
     set x 44
-    list [catch {trace var x(0) w traceProc} msg] $msg
+    list [catch {trace add variable x(0) write traceProc} msg] $msg
 } {1 {can't trace "x(0)": variable isn't array}}
 
 # Check deleting one trace from another.
@@ -593,126 +632,185 @@ test trace-11.8 {errors when setting variable traces} {
 test trace-12.1 {delete one trace from another} {
     proc delTraces {args} {
 	global x
-	trace vdel x r {traceTag 2}
-	trace vdel x r {traceTag 3}
-	trace vdel x r {traceTag 4}
+	trace remove variable x read {traceTag 2}
+	trace remove variable x read {traceTag 3}
+	trace remove variable x read {traceTag 4}
     }
     catch {unset x}
     set x 44
     set info {}
-    trace var x r {traceTag 1}
-    trace var x r {traceTag 2}
-    trace var x r {traceTag 3}
-    trace var x r {traceTag 4}
-    trace var x r delTraces 
-    trace var x r {traceTag 5}
+    trace add variable x read {traceTag 1}
+    trace add variable x read {traceTag 2}
+    trace add variable x read {traceTag 3}
+    trace add variable x read {traceTag 4}
+    trace add variable x read delTraces 
+    trace add variable x read {traceTag 5}
     set x
     set info
 } {5 1}
 
 # Check operation and syntax of "trace" command.
 
-test trace-13.1 {trace command (overall)} {
+# Syntax for adding/removing variable and command traces is basically the
+# same:
+#	trace add variable name opList command
+#	trace remove variable name opList command
+#
+# The following loops just get all the common "wrong # args" tests done.
+
+set i 0
+set start "wrong # args:"
+foreach type {variable command} {
+    foreach op {add remove} {
+	test trace-13.0.[incr i] "trace command, wrong # args errors" {
+	    list [catch {trace $op $type} msg] $msg
+	} [list 1 "$start should be \"trace $op $type name opList command\""]
+	test trace-13.0.[incr i] "trace command wrong # args errors" {
+	    list [catch {trace $op $type foo} msg] $msg
+	} [list 1 "$start should be \"trace $op $type name opList command\""]
+	test trace-13.0.[incr i] "trace command, wrong # args errors" {
+	    list [catch {trace $op $type foo bar} msg] $msg
+	} [list 1 "$start should be \"trace $op $type name opList command\""]
+	test trace-13.0.[incr i] "trace command, wrong # args errors" {
+	    list [catch {trace $op $type foo bar baz boo} msg] $msg
+	} [list 1 "$start should be \"trace $op $type name opList command\""]
+    }
+    test trace-13.0.[incr i] "trace command, wrong # args errors" {
+	list [catch {trace list $type foo bar} msg] $msg
+    } [list 1 "$start should be \"trace list $type name\""]
+    test trace-13.0.[incr i] "trace command, wrong # args errors" {
+	list [catch {trace list $type} msg] $msg
+    } [list 1 "$start should be \"trace list $type name\""]
+}
+
+test trace-13.1 "trace command, wrong # args errors" {
     list [catch {trace} msg] $msg
-} {1 {wrong # args: should be "trace option [arg arg ...]"}}
-test trace-13.2 {trace command (overall)} {
+} [list 1 "wrong # args: should be \"trace option ?arg arg ...?\""]
+test trace-13.2 "trace command, wrong # args errors" {
+    list [catch {trace add} msg] $msg
+} [list 1 "wrong # args: should be \"trace add type ?arg arg ...?\""]
+test trace-13.3 "trace command, wrong # args errors" {
+    list [catch {trace remove} msg] $msg
+} [list 1 "wrong # args: should be \"trace remove type ?arg arg ...?\""]
+test trace-13.4 "trace command, wrong # args errors" {
+    list [catch {trace list} msg] $msg
+} [list 1 "wrong # args: should be \"trace list type ?arg arg ...?\""]
+
+test trace-13.5 {trace command, invalid option} {
     list [catch {trace gorp} msg] $msg
-} {1 {bad option "gorp": must be variable, vdelete, or vinfo}}
-test trace-13.3 {trace command ("variable" option)} {
+} [list 1 "bad option \"gorp\": must be add, list, remove, variable, vdelete, or vinfo"]
+
+# Again, [trace ... command] and [trace ... variable] share syntax and
+# error message styles for their opList options; these loops test those 
+# error messages.
+
+set i 0
+set errs [list "array, read, unset, or write" "delete or rename"]
+set abbvs [list {a r u w} {d r}]
+foreach type {variable command} err $errs abbvlist $abbvs {
+    foreach op {add remove} {
+	test trace-13.6.[incr i] "trace $op $type errors" {
+	    list [catch {trace $op $type x {y z w} a} msg] $msg
+	} [list 1 "bad operation \"y\": must be $err"]
+	foreach abbv $abbvlist {
+	    test trace-13.6.[incr i] "trace $op $type rejects abbreviations" {
+		list [catch {trace $op $type x $abbv a} msg] $msg
+	    } [list 1 "bad operation \"$abbv\": must be $err"]
+	}
+	test trace-13.6.[incr i] "trace $op $type rejects null opList" {
+	    list [catch {trace $op $type x {} a} msg] $msg
+	} [list 1 "bad operation list \"\": must be one or more of $err"]
+    }
+}
+
+test trace-13.7 {trace command, "trace variable" errors} {
+    list [catch {trace variable} msg] $msg
+} [list 1 "wrong # args: should be \"trace variable name ops command\""]
+test trace-13.8 {trace command, "trace variable" errors} {
+    list [catch {trace variable x} msg] $msg
+} [list 1 "wrong # args: should be \"trace variable name ops command\""]
+test trace-13.9 {trace command, "trace variable" errors} {
     list [catch {trace variable x y} msg] $msg
-} {1 {wrong # args: should be "trace variable name ops command"}}
-test trace-13.4 {trace command ("variable" option)} {
-    list [catch {trace var x y z z2} msg] $msg
-} {1 {wrong # args: should be "trace variable name ops command"}}
-test trace-13.5 {trace command ("variable" option)} {
-    list [catch {trace var x y z} msg] $msg
-} {1 {bad operations "y": should be one or more of rwu}}
-test trace-13.6 {trace command ("vdelete" option)} {
-    list [catch {trace vdelete x y} msg] $msg
-} {1 {wrong # args: should be "trace vdelete name ops command"}}
-test trace-13.7 {trace command ("vdelete" option)} {
-    list [catch {trace vdelete x y z foo} msg] $msg
-} {1 {wrong # args: should be "trace vdelete name ops command"}}
-test trace-13.8 {trace command ("vdelete" option)} {
-    list [catch {trace vdelete x y z} msg] $msg
-} {1 {bad operations "y": should be one or more of rwu}}
-test trace-13.9 {trace command ("vdelete" option)} {
-    catch {unset x}
-    set info {}
-    trace var x w traceProc
-    trace vdelete x w traceProc
+} [list 1 "wrong # args: should be \"trace variable name ops command\""]
+test trace-13.10 {trace command, "trace variable" errors} {
+    list [catch {trace variable x y z w} msg] $msg
+} [list 1 "wrong # args: should be \"trace variable name ops command\""]
+test trace-13.11 {trace command, "trace variable" errors} {
+    list [catch {trace variable x y z} msg] $msg
+} [list 1 "bad operations \"y\": should be one or more of rwua"]
+
+
+test trace-13.9 {trace command ("remove variable" option)} {
+    catch {unset x}
+    set info {}
+    trace add variable x write traceProc
+    trace remove variable x write traceProc
 } {}
-test trace-13.10 {trace command ("vdelete" option)} {
+test trace-13.10 {trace command ("remove variable" option)} {
     catch {unset x}
     set info {}
-    trace var x w traceProc
-    trace vdelete x w traceProc
+    trace add variable x write traceProc
+    trace remove variable x write traceProc
     set x 12345
     set info
 } {}
-test trace-13.11 {trace command ("vdelete" option)} {
+test trace-13.11 {trace command ("remove variable" option)} {
     catch {unset x}
     set info {}
-    trace var x w {traceTag 1}
-    trace var x w traceProc
-    trace var x w {traceTag 2}
+    trace add variable x write {traceTag 1}
+    trace add variable x write traceProc
+    trace add variable x write {traceTag 2}
     set x yy
-    trace vdelete x w traceProc
+    trace remove variable x write traceProc
     set x 12345
-    trace vdelete x w {traceTag 1}
+    trace remove variable x write {traceTag 1}
     set x foo
-    trace vdelete x w {traceTag 2}
+    trace remove variable x write {traceTag 2}
     set x gorp
     set info
-} {2 x {} w 1 2 1 2}
-test trace-13.12 {trace command ("vdelete" option)} {
+} {2 x {} write 1 2 1 2}
+test trace-13.12 {trace command ("remove variable" option)} {
     catch {unset x}
     set info {}
-    trace var x w {traceTag 1}
-    trace vdelete x w non_existent
+    trace add variable x write {traceTag 1}
+    trace remove variable x write non_existent
     set x 12345
     set info
 } {1}
-test trace-13.13 {trace command ("vinfo" option)} {
-    list [catch {trace vinfo} msg] $msg]
-} {1 {wrong # args: should be "trace vinfo name"]}}
-test trace-13.14 {trace command ("vinfo" option)} {
-    list [catch {trace vinfo x y} msg] $msg]
-} {1 {wrong # args: should be "trace vinfo name"]}}
-test trace-13.15 {trace command ("vinfo" option)} {
-    catch {unset x}
-    trace var x w {traceTag 1}
-    trace var x w traceProc
-    trace var x w {traceTag 2}
-    trace vinfo x
-} {{w {traceTag 2}} {w traceProc} {w {traceTag 1}}}
-test trace-13.16 {trace command ("vinfo" option)} {
+test trace-13.15 {trace command ("list variable" option)} {
     catch {unset x}
-    trace vinfo x
+    trace add variable x write {traceTag 1}
+    trace add variable x write traceProc
+    trace add variable x write {traceTag 2}
+    trace list variable x
+} {{write {traceTag 2}} {write traceProc} {write {traceTag 1}}}
+test trace-13.16 {trace command ("list variable" option)} {
+    catch {unset x}
+    trace list variable x
 } {}
-test trace-13.17 {trace command ("vinfo" option)} {
+test trace-13.17 {trace command ("list variable" option)} {
     catch {unset x}
-    trace vinfo x(0)
+    trace list variable x(0)
 } {}
-test trace-13.18 {trace command ("vinfo" option)} {
+test trace-13.18 {trace command ("list variable" option)} {
     catch {unset x}
     set x 44
-    trace vinfo x(0)
+    trace list variable x(0)
 } {}
-test trace-13.19 {trace command ("vinfo" option)} {
+test trace-13.19 {trace command ("list variable" option)} {
     catch {unset x}
     set x 44
-    trace var x w {traceTag 1}
-    proc check {} {global x; trace vinfo x}
+    trace add variable x write {traceTag 1}
+    proc check {} {global x; trace list variable x}
     check
-} {{w {traceTag 1}}}
+} {{write {traceTag 1}}}
 
 # Check fancy trace commands (long ones, weird arguments, etc.)
 
 test trace-14.1 {long trace command} {
     catch {unset x}
     set info {}
-    trace var x w {traceTag {This is a very very long argument.  It's \
+    trace add variable x write {traceTag {This is a very very long argument.  It's \
 	designed to test out the facilities of TraceVarProc for dealing \
 	with such long arguments by malloc-ing space.  One possibility \
 	is that space doesn't get freed properly.  If this happens, then \
@@ -729,7 +827,7 @@ test trace-14.2 {long trace command result to ignore} {
 	generate a core leak if this command file is invoked over and over again
 	and memory isn't being recycled correctly"}
     catch {unset x}
-    trace var x w longResult
+    trace add variable x write longResult
     set x 44
     set x 5
     set x abcde
@@ -738,10 +836,10 @@ test trace-14.3 {special list-handling in trace commands} {
     catch {unset "x y z"}
     set "x y z(a\n\{)" 44
     set info {}
-    trace var "x y z(a\n\{)" w traceProc
+    trace add variable "x y z(a\n\{)" write traceProc
     set "x y z(a\n\{)" 33
     set info
-} "{x y z} a\\n\\{ w"
+} "{x y z} a\\n\\{ write"
 
 # Check for proper handling of unsets during traces.
 
@@ -769,162 +867,162 @@ test trace-15.1 {unsets during read traces} {
     catch {unset y}
     set y 1234
     set info {}
-    trace var y r {traceUnset y}
-    trace var y u {traceAppend unset}
+    trace add variable y read {traceUnset y}
+    trace add variable y unset {traceAppend unset}
     lappend info [catch {set y} msg] $msg
 } {unset 0 {} 1 {can't read "x": no such variable} 1 {can't read "y": no such variable}}
 test trace-15.2 {unsets during read traces} {
     catch {unset y}
     set y(0) 1234
     set info {}
-    trace var y(0) r {traceUnset y(0)}
+    trace add variable y(0) read {traceUnset y(0)}
     lappend info [catch {set y(0)} msg] $msg
 } {0 {} 1 {can't read "x": no such variable} 1 {can't read "y(0)": no such element in array}}
 test trace-15.3 {unsets during read traces} {
     catch {unset y}
     set y(0) 1234
     set info {}
-    trace var y(0) r {traceUnset y}
+    trace add variable y(0) read {traceUnset y}
     lappend info [catch {set y(0)} msg] $msg
 } {0 {} 1 {can't read "x": no such variable} 1 {can't read "y(0)": no such variable}}
 test trace-15.4 {unsets during read traces} {
     catch {unset y}
     set y 1234
     set info {}
-    trace var y r {traceReset y y}
+    trace add variable y read {traceReset y y}
     lappend info [catch {set y} msg] $msg
 } {0 {} 0 xyzzy 0 xyzzy}
 test trace-15.5 {unsets during read traces} {
     catch {unset y}
     set y(0) 1234
     set info {}
-    trace var y(0) r {traceReset y(0) y(0)}
+    trace add variable y(0) read {traceReset y(0) y(0)}
     lappend info [catch {set y(0)} msg] $msg
 } {0 {} 0 xyzzy 0 xyzzy}
 test trace-15.6 {unsets during read traces} {
     catch {unset y}
     set y(0) 1234
     set info {}
-    trace var y(0) r {traceReset y y(0)}
+    trace add variable y(0) read {traceReset y y(0)}
     lappend info [catch {set y(0)} msg] $msg [catch {set y(0)} msg] $msg
 } {0 {} 1 {can't set "y": upvar refers to element in deleted array} 1 {can't read "y(0)": no such variable} 1 {can't read "y(0)": no such variable}}
 test trace-15.7 {unsets during read traces} {
     catch {unset y}
     set y(0) 1234
     set info {}
-    trace var y(0) r {traceReset2 y y(0)}
+    trace add variable y(0) read {traceReset2 y y(0)}
     lappend info [catch {set y(0)} msg] $msg [catch {set y(0)} msg] $msg
 } {0 {} 0 xyzzy 1 {can't read "y(0)": no such element in array} 0 xyzzy}
 test trace-15.8 {unsets during write traces} {
     catch {unset y}
     set y 1234
     set info {}
-    trace var y w {traceUnset y}
-    trace var y u {traceAppend unset}
+    trace add variable y write {traceUnset y}
+    trace add variable y unset {traceAppend unset}
     lappend info [catch {set y xxx} msg] $msg
 } {unset 0 {} 1 {can't read "x": no such variable} 0 {}}
 test trace-15.9 {unsets during write traces} {
     catch {unset y}
     set y(0) 1234
     set info {}
-    trace var y(0) w {traceUnset y(0)}
+    trace add variable y(0) write {traceUnset y(0)}
     lappend info [catch {set y(0) xxx} msg] $msg
 } {0 {} 1 {can't read "x": no such variable} 0 {}}
 test trace-15.10 {unsets during write traces} {
     catch {unset y}
     set y(0) 1234
     set info {}
-    trace var y(0) w {traceUnset y}
+    trace add variable y(0) write {traceUnset y}
     lappend info [catch {set y(0) xxx} msg] $msg
 } {0 {} 1 {can't read "x": no such variable} 0 {}}
 test trace-15.11 {unsets during write traces} {
     catch {unset y}
     set y 1234
     set info {}
-    trace var y w {traceReset y y}
+    trace add variable y write {traceReset y y}
     lappend info [catch {set y xxx} msg] $msg
 } {0 {} 0 xyzzy 0 xyzzy}
 test trace-15.12 {unsets during write traces} {
     catch {unset y}
     set y(0) 1234
     set info {}
-    trace var y(0) w {traceReset y(0) y(0)}
+    trace add variable y(0) write {traceReset y(0) y(0)}
     lappend info [catch {set y(0) xxx} msg] $msg
 } {0 {} 0 xyzzy 0 xyzzy}
 test trace-15.13 {unsets during write traces} {
     catch {unset y}
     set y(0) 1234
     set info {}
-    trace var y(0) w {traceReset y y(0)}
+    trace add variable y(0) write {traceReset y y(0)}
     lappend info [catch {set y(0) xxx} msg] $msg [catch {set y(0)} msg] $msg
 } {0 {} 1 {can't set "y": upvar refers to element in deleted array} 0 {} 1 {can't read "y(0)": no such variable}}
 test trace-15.14 {unsets during write traces} {
     catch {unset y}
     set y(0) 1234
     set info {}
-    trace var y(0) w {traceReset2 y y(0)}
+    trace add variable y(0) write {traceReset2 y y(0)}
     lappend info [catch {set y(0) xxx} msg] $msg [catch {set y(0)} msg] $msg
 } {0 {} 0 xyzzy 0 {} 0 xyzzy}
 test trace-15.15 {unsets during unset traces} {
     catch {unset y}
     set y 1234
     set info {}
-    trace var y u {traceUnset y}
+    trace add variable y unset {traceUnset y}
     lappend info [catch {unset y} msg] $msg [catch {set y} msg] $msg
 } {1 {can't unset "x": no such variable} 1 {can't read "x": no such variable} 0 {} 1 {can't read "y": no such variable}}
 test trace-15.16 {unsets during unset traces} {
     catch {unset y}
     set y(0) 1234
     set info {}
-    trace var y(0) u {traceUnset y(0)}
+    trace add variable y(0) unset {traceUnset y(0)}
     lappend info [catch {unset y(0)} msg] $msg [catch {set y(0)} msg] $msg
 } {1 {can't unset "x": no such variable} 1 {can't read "x": no such variable} 0 {} 1 {can't read "y(0)": no such element in array}}
 test trace-15.17 {unsets during unset traces} {
     catch {unset y}
     set y(0) 1234
     set info {}
-    trace var y(0) u {traceUnset y}
+    trace add variable y(0) unset {traceUnset y}
     lappend info [catch {unset y(0)} msg] $msg [catch {set y(0)} msg] $msg
 } {0 {} 1 {can't read "x": no such variable} 0 {} 1 {can't read "y(0)": no such variable}}
 test trace-15.18 {unsets during unset traces} {
     catch {unset y}
     set y 1234
     set info {}
-    trace var y u {traceReset2 y y}
+    trace add variable y unset {traceReset2 y y}
     lappend info [catch {unset y} msg] $msg [catch {set y} msg] $msg
 } {1 {can't unset "y": no such variable} 0 xyzzy 0 {} 0 xyzzy}
 test trace-15.19 {unsets during unset traces} {
     catch {unset y}
     set y(0) 1234
     set info {}
-    trace var y(0) u {traceReset2 y(0) y(0)}
+    trace add variable y(0) unset {traceReset2 y(0) y(0)}
     lappend info [catch {unset y(0)} msg] $msg [catch {set y(0)} msg] $msg
 } {1 {can't unset "y(0)": no such element in array} 0 xyzzy 0 {} 0 xyzzy}
 test trace-15.20 {unsets during unset traces} {
     catch {unset y}
     set y(0) 1234
     set info {}
-    trace var y(0) u {traceReset2 y y(0)}
+    trace add variable y(0) unset {traceReset2 y y(0)}
     lappend info [catch {unset y(0)} msg] $msg [catch {set y(0)} msg] $msg
 } {0 {} 0 xyzzy 0 {} 0 xyzzy}
 test trace-15.21 {unsets cancelling traces} {
     catch {unset y}
     set y 1234
     set info {}
-    trace var y r {traceAppend first}
-    trace var y r {traceUnset y}
-    trace var y r {traceAppend third}
-    trace var y u {traceAppend unset}
+    trace add variable y read {traceAppend first}
+    trace add variable y read {traceUnset y}
+    trace add variable y read {traceAppend third}
+    trace add variable y unset {traceAppend unset}
     lappend info [catch {set y} msg] $msg
 } {third unset 0 {} 1 {can't read "x": no such variable} 1 {can't read "y": no such variable}}
 test trace-15.22 {unsets cancelling traces} {
     catch {unset y}
     set y(0) 1234
     set info {}
-    trace var y(0) r {traceAppend first}
-    trace var y(0) r {traceUnset y}
-    trace var y(0) r {traceAppend third}
-    trace var y(0) u {traceAppend unset}
+    trace add variable y(0) read {traceAppend first}
+    trace add variable y(0) read {traceUnset y}
+    trace add variable y(0) read {traceAppend third}
+    trace add variable y(0) unset {traceAppend unset}
     lappend info [catch {set y(0)} msg] $msg
 } {third unset 0 {} 1 {can't read "x": no such variable} 1 {can't read "y(0)": no such variable}}
 
@@ -933,30 +1031,30 @@ test trace-15.22 {unsets cancelling traces} {
 test trace-16.1 {trace doesn't prevent unset errors} {
     catch {unset x}
     set info {}
-    trace var x u {traceProc}
+    trace add variable x unset {traceProc}
     list [catch {unset x} msg] $msg $info
-} {1 {can't unset "x": no such variable} {x {} u}}
+} {1 {can't unset "x": no such variable} {x {} unset}}
 test trace-16.2 {traced variables must survive procedure exits} {
     catch {unset x}
-    proc p1 {} {global x; trace var x w traceProc}
+    proc p1 {} {global x; trace add variable x write traceProc}
     p1
-    trace vinfo x
-} {{w traceProc}}
+    trace list variable x
+} {{write traceProc}}
 test trace-16.3 {traced variables must survive procedure exits} {
     catch {unset x}
     set info {}
-    proc p1 {} {global x; trace var x w traceProc}
+    proc p1 {} {global x; trace add variable x write traceProc}
     p1
     set x 44
     set info
-} {x {} w}
+} {x {} write}
 
 # Be sure that procedure frames are released before unset traces
 # are invoked.
 
 test trace-17.1 {unset traces on procedure returns} {
     proc p1 {x y} {set a 44; p2 14}
-    proc p2 {z} {trace var z u {traceCheck {lsort [uplevel {info vars}]}}}
+    proc p2 {z} {trace add variable z unset {traceCheck {lsort [uplevel {info vars}]}}}
     set info {}
     p1 foo bar
     set info
@@ -968,6 +1066,265 @@ test trace-17.1 {unset traces on procedure returns} {
 catch {unset x}
 catch {unset y}
 
+test trace-17.2 {trace add command (command existence)} {
+    # Just in case!
+    catch {rename nosuchname ""}
+    list [catch {trace add command nosuchname rename traceCommand} msg] $msg
+} {1 {unknown command "nosuchname"}}
+test trace-17.3 {trace add command (command existence in ns)} {
+    list [catch {trace add command nosuchns::nosuchname rename traceCommand} msg] $msg
+} {1 {unknown command "nosuchns::nosuchname"}}
+
+
+test trace-18.1 {trace add command (rename option)} {
+    proc foo {} {}
+    catch {rename bar {}}
+    trace add command foo rename traceCommand
+    rename foo bar
+    set info
+} {foo bar rename}
+test trace-18.2 {traces stick with renamed commands} {
+    proc foo {} {}
+    catch {rename bar {}}
+    trace add command foo rename traceCommand
+    rename foo bar
+    rename bar foo
+    set info
+} {bar foo rename}
+test trace-18.2.1 {trace add command rename trace exists} {
+    proc foo {} {}
+    trace add command foo rename traceCommand
+    trace list command foo
+} {{rename traceCommand}}
+test trace-18.3 {command rename traces don't fire on command deletion} {
+    proc foo {} {}
+    set info {}
+    trace add command foo rename traceCommand
+    rename foo {}
+    set info
+} {}
+test trace-18.4 {trace add command rename doesn't trace recreated commands} {
+    proc foo {} {}
+    catch {rename bar {}}
+    trace add command foo rename traceCommand
+    proc foo {} {}
+    rename foo bar
+    set info
+} {}
+test trace-18.5 {trace add command deleted removes traces} {
+    proc foo {} {}
+    trace add command foo rename traceCommand
+    proc foo {} {}
+    trace list command foo
+} {}
+
+namespace eval tc {}
+proc tc::tcfoo {} {}
+test trace-18.6 {trace add command rename in namespace} {
+    trace add command tc::tcfoo rename traceCommand
+    rename tc::tcfoo tc::tcbar
+    set info
+} {tc::tcfoo tc::tcbar rename}
+test trace-18.7 {trace add command rename in namespace back again} {
+    rename tc::tcbar tc::tcfoo
+    set info
+} {tc::tcbar tc::tcfoo rename}
+test trace-18.8 {trace add command rename in namespace to out of namespace} {
+    rename tc::tcfoo tcbar
+    set info
+} {tc::tcfoo tcbar rename}
+test trace-18.9 {trace add command rename back into namespace} {
+    rename tcbar tc::tcfoo
+    set info
+} {tcbar tc::tcfoo rename}
+test trace-18.10 {trace add command failed rename doesn't trigger trace} {
+    set info {}
+    proc foo {} {}
+    proc bar {} {}
+    trace add command foo {rename delete} traceCommand
+    catch {rename foo bar}
+    set info
+} {}
+catch {rename foo {}}
+catch {rename bar {}}
+
+# Make sure it exists again
+proc foo {} {}
+
+test trace-19.1 {trace add command (delete option)} {
+    trace add command foo delete traceCommand
+    rename foo ""
+    set info
+} {foo {} delete}
+test trace-19.2 {trace add command delete doesn't trace recreated commands} {
+    set info {}
+    proc foo {} {}
+    rename foo ""
+    set info
+} {}
+test trace-19.2.1 {trace add command delete trace info} {
+    proc foo {} {}
+    trace add command foo delete traceCommand
+    trace list command foo
+} {{delete traceCommand}}
+test trace-19.3 {trace add command implicit delete} {
+    proc foo {} {}
+    trace add command foo delete traceCommand
+    proc foo {} {}
+    set info
+} {foo {} delete}
+test trace-19.3.1 {trace add command delete trace info} {
+    proc foo {} {}
+    trace list command foo
+} {}
+test trace-19.4 {trace add command rename followed by delete} {
+    set infotemp {}
+    proc foo {} {}
+    trace add command foo {rename delete} traceCommand
+    rename foo bar
+    lappend infotemp $info
+    rename bar {}
+    lappend infotemp $info
+    set info $infotemp
+    unset infotemp
+    set info
+} {{foo bar rename} {bar {} delete}}
+catch {rename foo {}}
+catch {rename bar {}}
+
+test trace-19.5 {trace add command rename and delete} {
+    set infotemp {}
+    set info {}
+    proc foo {} {}
+    trace add command foo {rename delete} traceCommand
+    rename foo bar
+    lappend infotemp $info
+    rename bar {}
+    lappend infotemp $info
+    set info $infotemp
+    unset infotemp
+    set info
+} {{foo bar rename} {bar {} delete}}
+
+test trace-19.6 {trace add command rename and delete in subinterp} {
+    set tc [interp create]
+    foreach p {traceCommand} {
+	$tc eval [list proc $p [info args $p] [info body $p]]
+    }
+    $tc eval [list set infotemp {}]
+    $tc eval [list set info {}]
+    $tc eval [list proc foo {} {}]
+    $tc eval [list trace add command foo {rename delete} traceCommand]
+    $tc eval [list rename foo bar]
+    $tc eval {lappend infotemp $info}
+    $tc eval [list rename bar {}]
+    $tc eval {lappend infotemp $info}
+    $tc eval {set info $infotemp}
+    $tc eval [list unset infotemp]
+    set info [$tc eval [list set info]]
+    interp delete $tc
+    set info
+} {{foo bar rename} {bar {} delete}}
+
+# I'd like it if this test could give 'foo {} d' as a result,
+# but interp deletion means there is no interp to evaluate
+# the trace in.
+test trace-19.7 {trace add command delete in subinterp while being deleted} {
+    set info {}
+    set tc [interp create]
+    interp alias $tc traceCommand {} traceCommand
+    $tc eval [list proc foo {} {}]
+    $tc eval [list trace add command foo {rename delete} traceCommand]
+    interp delete $tc
+    set info
+} {}
+
+proc traceDelete {cmd old new op} {
+    eval trace remove command $cmd [lindex [trace list command $cmd] 0]
+    global info
+    set info [list $old $new $op]
+}
+proc traceCmdrename {cmd old new op} {
+    rename $old someothername
+}
+proc traceCmddelete {cmd old new op} {
+    rename $old ""
+}
+test trace-19.8 {trace delete while trace is active} {
+    set info {}
+    proc foo {} {}
+    catch {rename bar {}}
+    trace add command foo {rename delete} [list traceDelete foo]
+    rename foo bar
+    list [set info] [trace list command bar]
+} {{foo bar rename} {}}
+
+test trace-19.9 {rename trace deletes command} {
+    set info {}
+    proc foo {} {}
+    catch {rename bar {}}
+    catch {rename someothername {}}
+    trace add command foo rename [list traceCmddelete foo]
+    rename foo bar
+    list [info commands foo] [info commands bar] [info commands someothername]
+} {{} {} {}}
+
+test trace-19.10 {rename trace renames command} {
+    set info {}
+    proc foo {} {}
+    catch {rename bar {}}
+    catch {rename someothername {}}
+    trace add command foo rename [list traceCmdrename foo]
+    rename foo bar
+    set info [list [info commands foo] [info commands bar] [info commands someothername]]
+    rename someothername {}
+    set info
+} {{} {} someothername}
+
+test trace-19.11 {delete trace deletes command} {
+    set info {}
+    proc foo {} {}
+    catch {rename bar {}}
+    catch {rename someothername {}}
+    trace add command foo delete [list traceCmddelete foo]
+    rename foo {}
+    list [info commands foo] [info commands bar] [info commands someothername]
+} {{} {} {}}
+
+test trace-19.12 {delete trace renames command} {
+    set info {}
+    proc foo {} {}
+    catch {rename bar {}}
+    catch {rename someothername {}}
+    trace add command foo delete [list traceCmdrename foo]
+    rename foo bar
+    rename bar {}
+    # None of these should exist.
+    list [info commands foo] [info commands bar] [info commands someothername]
+} {{} {} {}}
+
+proc foo {b} { set a $b }
+
+
+# Delete arrays when done, so they can be re-used as scalars
+# elsewhere.
+
+catch {unset x}
+catch {unset y}
+
+# Delete procedures when done, so we don't clash with other tests
+# (e.g. foobar will clash with 'unknown' tests).
+catch {rename foobar {}}
+catch {rename foo {}}
+catch {rename bar {}}
+
+# Delete arrays when done, so they can be re-used as scalars
+# elsewhere.
+
+catch {unset x}
+catch {unset y}
+
+
 # cleanup
 ::tcltest::cleanupTests
 return
author	ericm <ericm>	2000-08-25 02:04:26 (GMT)
committer	ericm <ericm>	2000-08-25 02:04:26 (GMT)
commit	5264f0bed54365470c89b67b7b18851776a0ceb1 (patch)
tree	a3a8e43d27bbf411eb0d9049598838a1c25f3b8b
parent	4c6c508ce30845f9e15d7d5f1db2821a92c7a157 (diff)
download	tcl-5264f0bed54365470c89b67b7b18851776a0ceb1.zip tcl-5264f0bed54365470c89b67b7b18851776a0ceb1.tar.gz tcl-5264f0bed54365470c89b67b7b18851776a0ceb1.tar.bz2