diff options
Diffstat (limited to 'generic/tclHistory.c')
| -rw-r--r-- | generic/tclHistory.c | 86 |
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 |