diff options
author | msofer <msofer@noemail.net> | 2006-09-30 17:56:45 (GMT) |
---|---|---|
committer | msofer <msofer@noemail.net> | 2006-09-30 17:56:45 (GMT) |
commit | 750565088a290c53edc57334b616d075379152fd (patch) | |
tree | ad9a7220c6ca69cd16f1f4d0574ec34d46c1ad63 /generic/tclHistory.c | |
parent | c723d946da9d63d312292482b1363cb1a5bb3370 (diff) | |
download | tcl-750565088a290c53edc57334b616d075379152fd.zip tcl-750565088a290c53edc57334b616d075379152fd.tar.gz tcl-750565088a290c53edc57334b616d075379152fd.tar.bz2 |
* generic/tclCompile.c:
* generic/tclHistory.c:
* generic/tclInt.h:
* generic/tclProc.c: made Tcl_RecordAndEvalObj not call "history"
if it has been redefined to an empty proc, in order to reduce the
noise when debugging [FR 1190441]. Moved TclCompileNoOp from
tclProc.c to tclCompile.c
FossilOrigin-Name: 639783a61c6753063dca371837538b907e0ddfbf
Diffstat (limited to 'generic/tclHistory.c')
-rw-r--r-- | generic/tclHistory.c | 45 |
1 files changed, 30 insertions, 15 deletions
diff --git a/generic/tclHistory.c b/generic/tclHistory.c index daef8f3..e77b230 100644 --- a/generic/tclHistory.c +++ b/generic/tclHistory.c @@ -12,7 +12,7 @@ * 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.8 2005/10/18 14:34:41 dkf Exp $ + * RCS: @(#) $Id: tclHistory.c,v 1.9 2006/09/30 17:56:47 msofer Exp $ */ #include "tclInt.h" @@ -112,29 +112,44 @@ Tcl_RecordAndEvalObj( * 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; + result = Tcl_GetCommandInfo(interp, "history", &info); - objPtr = Tcl_NewListObj(3, list); - Tcl_IncrRefCount(objPtr); - (void) Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL); - Tcl_DecrRefCount(objPtr); + if (result && (info.objProc == TclObjInterpProc)) { + Proc *procPtr = (Proc *)(info.objClientData); + call = (procPtr->cmdPtr->compileProc != TclCompileNoOp); + } - /* - * One possible failure mode above: exceeding a resource limit. - */ + if (call) { - if (Tcl_LimitExceeded(interp)) { - return TCL_ERROR; + /* + * Do recording by eval'ing a tcl history command: history add $cmd. + */ + + 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); + + /* + * One possible failure mode above: exceeding a resource limit. + */ + + if (Tcl_LimitExceeded(interp)) { + return TCL_ERROR; + } } /* |