1 files changed, 91 insertions, 18 deletions

diff --git a/generic/tclHistory.c b/generic/tclHistory.c
index daef8f3..b10d423 100644
--- a/generic/tclHistory.c
+++ b/generic/tclHistory.c
@@ -11,11 +11,27 @@
  *
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclHistory.c,v 1.8 2005/10/18 14:34:41 dkf Exp $
  */
 
 #include "tclInt.h"
+
+/*
+ * Type of the assocData structure used to hold the reference to the [history
+ * add] subcommand, used in Tcl_RecordAndEvalObj.
+ */
+
+typedef struct {
+    Tcl_Obj *historyObj;	/* == "::history" */
+    Tcl_Obj *addObj;		/* == "add" */
+} HistoryObjs;
+
+#define HISTORY_OBJS_KEY	"::tcl::HistoryObjs"
+
+/*
+ * Static functions in this file.
+ */
+
+static Tcl_InterpDeleteProc DeleteHistoryObjs;
 
 /*
  *----------------------------------------------------------------------
@@ -39,7 +55,7 @@ int
 Tcl_RecordAndEval(
     Tcl_Interp *interp,		/* Token for interpreter in which command will
 				 * be executed. */
-    CONST char *cmd,		/* Command to record. */
+    const char *cmd,		/* Command to record. */
     int flags)			/* Additional flags. TCL_NO_EVAL means only
 				 * record: don't execute command.
 				 * TCL_EVAL_GLOBAL means use Tcl_GlobalEval
@@ -112,29 +128,57 @@ Tcl_RecordAndEvalObj(
 				 * in global variable context instead of the
 				 * current procedure. */
 {
-    int result;
-    Tcl_Obj *list[3];
-    register Tcl_Obj *objPtr;
+    int result, call = 1;
+    Tcl_CmdInfo info;
+    HistoryObjs *histObjsPtr =
+	    Tcl_GetAssocData(interp, HISTORY_OBJS_KEY, NULL);
 
     /*
-     * Do recording by eval'ing a tcl history command: history add $cmd.
+     * Create the references to the [::history add] command if necessary.
      */
 
-    list[0] = Tcl_NewStringObj("history", -1);
-    list[1] = Tcl_NewStringObj("add", -1);
-    list[2] = cmdPtr;
-
-    objPtr = Tcl_NewListObj(3, list);
-    Tcl_IncrRefCount(objPtr);
-    (void) Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL);
-    Tcl_DecrRefCount(objPtr);
+    if (histObjsPtr == NULL) {
+	histObjsPtr = ckalloc(sizeof(HistoryObjs));
+	TclNewLiteralStringObj(histObjsPtr->historyObj, "::history");
+	TclNewLiteralStringObj(histObjsPtr->addObj, "add");
+	Tcl_IncrRefCount(histObjsPtr->historyObj);
+	Tcl_IncrRefCount(histObjsPtr->addObj);
+	Tcl_SetAssocData(interp, HISTORY_OBJS_KEY, DeleteHistoryObjs,
+		histObjsPtr);
+    }
 
     /*
-     * One possible failure mode above: exceeding a resource limit.
+     * Do not call [history] if it has been replaced by an empty proc
      */
 
-    if (Tcl_LimitExceeded(interp)) {
-	return TCL_ERROR;
+    result = Tcl_GetCommandInfo(interp, "::history", &info);
+    if (result && (info.deleteProc == TclProcDeleteProc)) {
+	Proc *procPtr = (Proc *) info.objClientData;
+	call = (procPtr->cmdPtr->compileProc != TclCompileNoOp);
+    }
+
+    if (call) {
+	Tcl_Obj *list[3];
+
+	/*
+	 * Do recording by eval'ing a tcl history command: history add $cmd. 
+	 */
+
+	list[0] = histObjsPtr->historyObj;
+	list[1] = histObjsPtr->addObj;
+	list[2] = cmdPtr;
+
+	Tcl_IncrRefCount(cmdPtr);
+	(void) Tcl_EvalObjv(interp, 3, list, TCL_EVAL_GLOBAL);
+	Tcl_DecrRefCount(cmdPtr);
+
+	/*
+	 * One possible failure mode above: exceeding a resource limit.
+	 */
+	
+	if (Tcl_LimitExceeded(interp)) {
+	    return TCL_ERROR;
+	}
     }
 
     /*
@@ -149,6 +193,35 @@ Tcl_RecordAndEvalObj(
 }
 
 /*
+ *----------------------------------------------------------------------
+ *
+ * DeleteHistoryObjs --
+ *
+ *	Called to delete the references to the constant words used when adding
+ *	to the history.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The constant words may be deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DeleteHistoryObjs(
+    ClientData clientData,
+    Tcl_Interp *interp)
+{
+    register HistoryObjs *histObjsPtr = clientData;
+
+    TclDecrRefCount(histObjsPtr->historyObj);
+    TclDecrRefCount(histObjsPtr->addObj);
+    ckfree(histObjsPtr);
+}
+
+/*
  * Local Variables:
  * mode: c
  * c-basic-offset: 4