diff options
Diffstat (limited to 'generic/tclHistory.c')
| -rw-r--r-- | generic/tclHistory.c | 103 |
1 files changed, 65 insertions, 38 deletions
diff --git a/generic/tclHistory.c b/generic/tclHistory.c index 9ff3f49..a23e102 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,13 +9,11 @@ * 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" - /* *---------------------------------------------------------------------- @@ -23,8 +21,7 @@ * 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 @@ -37,12 +34,12 @@ */ int -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_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. */ { @@ -60,18 +57,17 @@ Tcl_RecordAndEval(interp, cmd, flags) 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. */ - Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)), - TCL_VOLATILE); + (void) Tcl_GetStringResult(interp); /* * 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. @@ -103,33 +99,56 @@ Tcl_RecordAndEval(interp, cmd, flags) */ int -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 +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 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; + int result, call = 1; Tcl_Obj *list[3]; register Tcl_Obj *objPtr; + Tcl_CmdInfo info; /* - * Do recording by eval'ing a tcl history command: history add $cmd. + * Do not call [history] if it has been replaced by an empty proc */ - 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); + result = Tcl_GetCommandInfo(interp, "history", &info); + + if (result && (info.objProc == TclObjInterpProc)) { + Proc *procPtr = (Proc *)(info.objClientData); + call = (procPtr->cmdPtr->compileProc != TclCompileNoOp); + } + + if (call) { + + /* + * Do recording by eval'ing a tcl history command: history add $cmd. + */ + + TclNewLiteralStringObj(list[0], "history"); + TclNewLiteralStringObj(list[1], "add"); + list[2] = cmdPtr; + + objPtr = Tcl_NewListObj(3, list); + Tcl_IncrRefCount(objPtr); + (void) Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL); + Tcl_DecrRefCount(objPtr); + + /* + * One possible failure mode above: exceeding a resource limit. + */ + + if (Tcl_LimitExceeded(interp)) { + return TCL_ERROR; + } + } /* * Execute the command. @@ -141,3 +160,11 @@ Tcl_RecordAndEvalObj(interp, cmdPtr, flags) } return result; } + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ |