diff options
author | William Joye <wjoye@cfa.harvard.edu> | 2017-09-22 18:57:19 (GMT) |
---|---|---|
committer | William Joye <wjoye@cfa.harvard.edu> | 2017-09-22 18:57:19 (GMT) |
commit | 2aff4a96fa0286d875bddec0019648e2c6431cbc (patch) | |
tree | f7a9a4800a3f3ad4b77470b8383529176d8b7181 /tcl8.6/generic/tclHistory.c | |
parent | 3fa8e6dc88e8041b6cb88d1b1e9c05676d3346b7 (diff) | |
parent | 29ccecd87709feda60d191f6aaba324ccad91f55 (diff) | |
download | blt-2aff4a96fa0286d875bddec0019648e2c6431cbc.zip blt-2aff4a96fa0286d875bddec0019648e2c6431cbc.tar.gz blt-2aff4a96fa0286d875bddec0019648e2c6431cbc.tar.bz2 |
Merge commit '29ccecd87709feda60d191f6aaba324ccad91f55' as 'tcl8.6'
Diffstat (limited to 'tcl8.6/generic/tclHistory.c')
-rw-r--r-- | tcl8.6/generic/tclHistory.c | 230 |
1 files changed, 230 insertions, 0 deletions
diff --git a/tcl8.6/generic/tclHistory.c b/tcl8.6/generic/tclHistory.c new file mode 100644 index 0000000..b08e352 --- /dev/null +++ b/tcl8.6/generic/tclHistory.c @@ -0,0 +1,230 @@ +/* + * tclHistory.c -- + * + * This module and the Tcl library file history.tcl together implement + * Tcl command history. Tcl_RecordAndEval(Obj) can be called to record + * commands ("events") before they are executed. Commands defined in + * history.tcl may be used to perform history substitutions. + * + * Copyright (c) 1990-1993 The Regents of the University of California. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. + * + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#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; + +/* + *---------------------------------------------------------------------- + * + * Tcl_RecordAndEval -- + * + * This procedure adds its command argument to the current list of + * recorded events and then executes the command by calling Tcl_Eval. + * + * Results: + * The return value is a standard Tcl return value, the result of + * executing cmd. + * + * Side effects: + * The command is recorded and executed. + * + *---------------------------------------------------------------------- + */ + +int +Tcl_RecordAndEval( + Tcl_Interp *interp, /* Token for interpreter in which command will + * be executed. */ + 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 + * instead of Tcl_Eval. */ +{ + register Tcl_Obj *cmdPtr; + int length = strlen(cmd); + int result; + + if (length > 0) { + /* + * Call Tcl_RecordAndEvalObj to do the actual work. + */ + + cmdPtr = Tcl_NewStringObj(cmd, length); + Tcl_IncrRefCount(cmdPtr); + result = Tcl_RecordAndEvalObj(interp, cmdPtr, flags); + + /* + * Move the interpreter's object result to the string result, then + * reset the object result. + */ + + (void) Tcl_GetStringResult(interp); + + /* + * Discard the Tcl object created to hold the command. + */ + + Tcl_DecrRefCount(cmdPtr); + } else { + /* + * An empty string. Just reset the interpreter's result. + */ + + Tcl_ResetResult(interp); + result = TCL_OK; + } + return result; +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_RecordAndEvalObj -- + * + * This procedure adds the command held in its argument object to the + * current list of recorded events and then executes the command by + * calling Tcl_EvalObj. + * + * Results: + * The return value is a standard Tcl return value, the result of + * executing the command. + * + * Side effects: + * The command is recorded and executed. + * + *---------------------------------------------------------------------- + */ + +int +Tcl_RecordAndEvalObj( + Tcl_Interp *interp, /* Token for interpreter in which command will + * be executed. */ + Tcl_Obj *cmdPtr, /* Points to object holding the command to + * record and execute. */ + int flags) /* Additional flags. TCL_NO_EVAL means record + * only: don't execute the command. + * TCL_EVAL_GLOBAL means evaluate the script + * in global variable context instead of the + * current procedure. */ +{ + int result, call = 1; + Tcl_CmdInfo info; + HistoryObjs *histObjsPtr = + Tcl_GetAssocData(interp, HISTORY_OBJS_KEY, NULL); + + /* + * Create the references to the [::history add] command if necessary. + */ + + 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 + */ + + 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; + } + } + + /* + * Execute the command. + */ + + result = TCL_OK; + if (!(flags & TCL_NO_EVAL)) { + result = Tcl_EvalObjEx(interp, cmdPtr, flags & TCL_EVAL_GLOBAL); + } + return result; +} + +/* + *---------------------------------------------------------------------- + * + * 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 + * fill-column: 78 + * End: + */ |