1 files changed, 75 insertions, 15 deletions

diff --git a/generic/tclHistory.c b/generic/tclHistory.c
index a23e102..b10d423 100644
--- a/generic/tclHistory.c
+++ b/generic/tclHistory.c
@@ -14,6 +14,24 @@
  */
 
 #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;
 
 /*
  *----------------------------------------------------------------------
@@ -37,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
@@ -111,36 +129,49 @@ Tcl_RecordAndEvalObj(
 				 * current procedure. */
 {
     int result, call = 1;
-    Tcl_Obj *list[3];
-    register Tcl_Obj *objPtr;
     Tcl_CmdInfo info;
+    HistoryObjs *histObjsPtr =
+	    Tcl_GetAssocData(interp, HISTORY_OBJS_KEY, NULL);
 
     /*
-     * Do not call [history] if it has been replaced by an empty proc
+     * Create the references to the [::history add] command if necessary.
      */
 
-    result = Tcl_GetCommandInfo(interp, "history", &info);
+    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);
+    }
+
+    /*
+     * Do not call [history] if it has been replaced by an empty proc
+     */
 
-    if (result && (info.objProc == TclObjInterpProc)) {
-	Proc *procPtr = (Proc *)(info.objClientData);
+    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. 
 	 */
 
-	TclNewLiteralStringObj(list[0], "history");
-	TclNewLiteralStringObj(list[1], "add");
+	list[0] = histObjsPtr->historyObj;
+	list[1] = histObjsPtr->addObj;
 	list[2] = cmdPtr;
-	
-	objPtr = Tcl_NewListObj(3, list);
-	Tcl_IncrRefCount(objPtr);
-	(void) Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL);
-	Tcl_DecrRefCount(objPtr);
-	
+
+	Tcl_IncrRefCount(cmdPtr);
+	(void) Tcl_EvalObjv(interp, 3, list, TCL_EVAL_GLOBAL);
+	Tcl_DecrRefCount(cmdPtr);
+
 	/*
 	 * One possible failure mode above: exceeding a resource limit.
 	 */
@@ -162,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