diff options
Diffstat (limited to 'generic')
| -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 48739ad..0d6af52 100644 --- a/generic/tclHistory.c +++ b/generic/tclHistory.c @@ -12,10 +12,28 @@ * 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.13 2008/10/26 18:34:04 dkf Exp $ + * RCS: @(#) $Id: tclHistory.c,v 1.14 2009/12/29 16:58: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; /* *---------------------------------------------------------------------- @@ -113,36 +131,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 = (HistoryObjs *) 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 + */ + 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. */ @@ -164,6 +195,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((char *) histObjsPtr); +} + +/* * Local Variables: * mode: c * c-basic-offset: 4 |