diff options
author | William Joye <wjoye@cfa.harvard.edu> | 2018-12-25 19:55:50 (GMT) |
---|---|---|
committer | William Joye <wjoye@cfa.harvard.edu> | 2018-12-25 19:55:50 (GMT) |
commit | ff51550ee89b473c63df78de6b2a413f21105687 (patch) | |
tree | bcdca927ed2a7b05c647b9a6bfdfd4a7ca5c730e /tcl8.6/generic/tclHistory.c | |
parent | 01cbf5b15ea760408c24288ccb5cf8e0af9aa299 (diff) | |
download | blt-ff51550ee89b473c63df78de6b2a413f21105687.zip blt-ff51550ee89b473c63df78de6b2a413f21105687.tar.gz blt-ff51550ee89b473c63df78de6b2a413f21105687.tar.bz2 |
update tcl/tk
Diffstat (limited to 'tcl8.6/generic/tclHistory.c')
-rw-r--r-- | tcl8.6/generic/tclHistory.c | 230 |
1 files changed, 0 insertions, 230 deletions
diff --git a/tcl8.6/generic/tclHistory.c b/tcl8.6/generic/tclHistory.c deleted file mode 100644 index b08e352..0000000 --- a/tcl8.6/generic/tclHistory.c +++ /dev/null @@ -1,230 +0,0 @@ -/* - * 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: - */ |