? generic/tclObj.c.ORIG
? unix/.log
? unix/.ofl
? unix/ERR
? unix/dltest.marker
? unix/tclsh-head
? unix/tclsh-noAsync
? unix/tclsh-noStart
? unix/x.log
? unix/x.ofl
Index: generic/tclBasic.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclBasic.c,v
retrieving revision 1.99
diff -u -r1.99 tclBasic.c
--- generic/tclBasic.c	6 Apr 2004 22:25:48 -0000	1.99
+++ generic/tclBasic.c	28 Apr 2004 11:00:57 -0000
@@ -50,6 +50,10 @@
  * The built-in commands, and the procedures that implement them:
  */
 
+int AutoCleaningCmdObjCmd _ANSI_ARGS_((ClientData clientData, 
+        Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[]));
+
+
 static CmdInfo builtInCmds[] = {
     /*
      * Commands in the generic core. Note that at least one of the proc or
@@ -489,6 +493,14 @@
     iPtr->flags |= EXPR_INITIALIZED;
 
     /*
+     * Create the AutoCleaningCmd command.
+     */
+
+    Tcl_CreateObjCommand(interp, "::tcl::unsupported::AutoCleaningCmd",
+	    AutoCleaningCmdObjCmd, NULL,NULL);
+    
+    
+    /*
      * Do Multiple/Safe Interps Tcl init stuff
      */
 
@@ -2711,6 +2723,11 @@
     cmdPtr->refCount--;
     if (cmdPtr->refCount <= 0) {
 	ckfree((char *) cmdPtr);
+    } else if ((cmdPtr->flags & CMD_AUTOCLEAN)
+	    && !(cmdPtr->flags & CMD_IS_DELETED)
+	    && (cmdPtr->refCount == 1)) {
+	Tcl_DeleteCommandFromToken(cmdPtr->nsPtr->interp,
+		(Tcl_Command)cmdPtr);
     }
 }
 
@@ -4996,3 +5013,88 @@
     }
 }
  
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AutoCleaningCmdObjCmd
+ *
+ *	This object-based procedure is invoked to process the
+ *      ::tcl::unsupported::AutoCleaningCmd command.
+ *
+ *      When the CMD_AUTOCLEAN flag is set, the command will be
+ *      deleted when its reference count reaches 1 - ie, when
+ *      its only reference is in its namespace's hash table.
+ *
+ * Arguments:
+ *      objv[1] is the name of the command whose autocleaning
+ *              flag will be set
+ *      objv[2] (if present) is a boolean indicating if the flag
+ *              is to be set or unset. When absent,
+ *
+ * Results:
+ *	A standard Tcl result; only returns an error if objc
+ *      is neither 2 or 3.
+ *
+ * Side effects:
+ *	- The CMD_AUTOCLEAN flag of the command named objv[1] is set to
+ *        the requested value.
+ *      - objv[1] is converted to cmdNameType
+ *      - the interp's result is set to the CMD_AUTOCLEAN flag value
+ *
+ * **********
+ *  WARNING
+ * **********
+ *
+ * Autocleaning commands can break the Tcl semantics. Care has to be
+ * taken to insure that the command can be recreated from its name's
+ * string rep.
+ *
+ * This command is used in [lambda] implementations (TIP 187); they
+ * rely on [unknown] to restore the Tcl semantics.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+AutoCleaningCmdObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    Command *cmdPtr;
+    int bool;
+
+    if (objc == 3) {
+	if (Tcl_GetBooleanFromObj(interp, objv[2], &bool) != TCL_OK) {
+	    /* FIXME: error message */
+	    return TCL_ERROR;
+	}
+    } else if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "cmdName ?boolVal?");
+	return TCL_ERROR;
+    }
+
+    cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[1]);
+    if (cmdPtr != NULL) {
+	if (objc == 2) {
+	    bool = ((cmdPtr->flags & CMD_AUTOCLEAN) != 0);
+	} else {
+	    if (bool) {
+		cmdPtr->flags |= CMD_AUTOCLEAN;
+	    } else {
+		cmdPtr->flags &= ~CMD_AUTOCLEAN;
+	    }
+	}
+    } else {
+	/*
+	 * No such command is defined; return 0.
+	 */
+	
+	bool = 0;
+    }
+
+    Tcl_SetObjResult(interp, Tcl_NewIntObj(bool));
+    return TCL_OK;
+}
Index: generic/tclInt.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v
retrieving revision 1.154
diff -u -r1.154 tclInt.h
--- generic/tclInt.h	25 Apr 2004 20:16:31 -0000	1.154
+++ generic/tclInt.h	28 Apr 2004 11:01:03 -0000
@@ -1080,6 +1080,10 @@
  *				underway for a rename/delete change.
  *				See the two flags below for which is
  *				currently being processed.
+ * CMD_AUTOCLEAN                1 means this command should delete itself
+ *                              when its reference count reaches 1 - ie,
+ *                              when the only reference is in its namespace's
+ *                              hash table.
  * CMD_HAS_EXEC_TRACES -	1 means that this command has at least
  *                              one execution trace (as opposed to simple
  *                              delete/rename traces) in its tracePtr list.
@@ -1092,6 +1096,7 @@
 #define CMD_IS_DELETED		0x1
 #define CMD_TRACE_ACTIVE	0x2
 #define CMD_HAS_EXEC_TRACES	0x4
+#define CMD_AUTOCLEAN	        0x8
 
 /*
  *----------------------------------------------------------------
