diff options
Diffstat (limited to 'generic/tclHistory.c')
| -rw-r--r-- | generic/tclHistory.c | 165 |
1 files changed, 39 insertions, 126 deletions
diff --git a/generic/tclHistory.c b/generic/tclHistory.c index b10d423..9ff3f49 100644 --- a/generic/tclHistory.c +++ b/generic/tclHistory.c @@ -1,4 +1,4 @@ -/* +/* * tclHistory.c -- * * This module and the Tcl library file history.tcl together implement @@ -9,29 +9,13 @@ * 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. + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" +#include "tclPort.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; /* *---------------------------------------------------------------------- @@ -39,7 +23,8 @@ 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. + * recorded events and then executes the command by calling + * Tcl_Eval. * * Results: * The return value is a standard Tcl return value, the result of @@ -52,12 +37,12 @@ static Tcl_InterpDeleteProc DeleteHistoryObjs; */ 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_RecordAndEval(interp, cmd, flags) + 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. */ { @@ -75,17 +60,18 @@ Tcl_RecordAndEval( result = Tcl_RecordAndEvalObj(interp, cmdPtr, flags); /* - * Move the interpreter's object result to the string result, then - * reset the object result. + * Move the interpreter's object result to the string result, + * then reset the object result. */ - (void) Tcl_GetStringResult(interp); + Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)), + TCL_VOLATILE); /* * Discard the Tcl object created to hold the command. */ - - Tcl_DecrRefCount(cmdPtr); + + Tcl_DecrRefCount(cmdPtr); } else { /* * An empty string. Just reset the interpreter's result. @@ -117,69 +103,33 @@ Tcl_RecordAndEval( */ 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 +Tcl_RecordAndEvalObj(interp, cmdPtr, flags) + 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 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); + int result; + Tcl_Obj *list[3]; + register Tcl_Obj *objPtr; /* - * Create the references to the [::history add] command if necessary. + * Do recording by eval'ing a tcl history command: history add $cmd. */ - 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; - } - } + list[0] = Tcl_NewStringObj("history", -1); + list[1] = Tcl_NewStringObj("add", -1); + list[2] = cmdPtr; + + objPtr = Tcl_NewListObj(3, list); + Tcl_IncrRefCount(objPtr); + (void) Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL); + Tcl_DecrRefCount(objPtr); /* * Execute the command. @@ -191,40 +141,3 @@ Tcl_RecordAndEvalObj( } 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: - */ |