summaryrefslogtreecommitdiffstats
path: root/generic/tclHistory.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclHistory.c')
-rw-r--r--generic/tclHistory.c86
1 files changed, 73 insertions, 13 deletions
diff --git a/generic/tclHistory.c b/generic/tclHistory.c
index 97cbdcd..b08e352 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,35 +129,48 @@ 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