1/* 2 * tclHistory.c -- 3 * 4 * This module and the Tcl library file history.tcl together implement 5 * Tcl command history. Tcl_RecordAndEval(Obj) can be called to record 6 * commands ("events") before they are executed. Commands defined in 7 * history.tcl may be used to perform history substitutions. 8 * 9 * Copyright (c) 1990-1993 The Regents of the University of California. 10 * Copyright (c) 1994-1997 Sun Microsystems, Inc. 11 * 12 * See the file "license.terms" for information on usage and redistribution of 13 * this file, and for a DISCLAIMER OF ALL WARRANTIES. 14 * 15 * RCS: @(#) $Id: tclHistory.c,v 1.10 2007/04/10 14:47:15 dkf Exp $ 16 */ 17 18#include "tclInt.h" 19 20/* 21 *---------------------------------------------------------------------- 22 * 23 * Tcl_RecordAndEval -- 24 * 25 * This procedure adds its command argument to the current list of 26 * recorded events and then executes the command by calling Tcl_Eval. 27 * 28 * Results: 29 * The return value is a standard Tcl return value, the result of 30 * executing cmd. 31 * 32 * Side effects: 33 * The command is recorded and executed. 34 * 35 *---------------------------------------------------------------------- 36 */ 37 38int 39Tcl_RecordAndEval( 40 Tcl_Interp *interp, /* Token for interpreter in which command will 41 * be executed. */ 42 CONST char *cmd, /* Command to record. */ 43 int flags) /* Additional flags. TCL_NO_EVAL means only 44 * record: don't execute command. 45 * TCL_EVAL_GLOBAL means use Tcl_GlobalEval 46 * instead of Tcl_Eval. */ 47{ 48 register Tcl_Obj *cmdPtr; 49 int length = strlen(cmd); 50 int result; 51 52 if (length > 0) { 53 /* 54 * Call Tcl_RecordAndEvalObj to do the actual work. 55 */ 56 57 cmdPtr = Tcl_NewStringObj(cmd, length); 58 Tcl_IncrRefCount(cmdPtr); 59 result = Tcl_RecordAndEvalObj(interp, cmdPtr, flags); 60 61 /* 62 * Move the interpreter's object result to the string result, then 63 * reset the object result. 64 */ 65 66 (void) Tcl_GetStringResult(interp); 67 68 /* 69 * Discard the Tcl object created to hold the command. 70 */ 71 72 Tcl_DecrRefCount(cmdPtr); 73 } else { 74 /* 75 * An empty string. Just reset the interpreter's result. 76 */ 77 78 Tcl_ResetResult(interp); 79 result = TCL_OK; 80 } 81 return result; 82} 83 84/* 85 *---------------------------------------------------------------------- 86 * 87 * Tcl_RecordAndEvalObj -- 88 * 89 * This procedure adds the command held in its argument object to the 90 * current list of recorded events and then executes the command by 91 * calling Tcl_EvalObj. 92 * 93 * Results: 94 * The return value is a standard Tcl return value, the result of 95 * executing the command. 96 * 97 * Side effects: 98 * The command is recorded and executed. 99 * 100 *---------------------------------------------------------------------- 101 */ 102 103int 104Tcl_RecordAndEvalObj( 105 Tcl_Interp *interp, /* Token for interpreter in which command will 106 * be executed. */ 107 Tcl_Obj *cmdPtr, /* Points to object holding the command to 108 * record and execute. */ 109 int flags) /* Additional flags. TCL_NO_EVAL means record 110 * only: don't execute the command. 111 * TCL_EVAL_GLOBAL means evaluate the script 112 * in global variable context instead of the 113 * current procedure. */ 114{ 115 int result, call = 1; 116 Tcl_Obj *list[3]; 117 register Tcl_Obj *objPtr; 118 Tcl_CmdInfo info; 119 120 /* 121 * Do not call [history] if it has been replaced by an empty proc 122 */ 123 124 result = Tcl_GetCommandInfo(interp, "history", &info); 125 126 if (result && (info.objProc == TclObjInterpProc)) { 127 Proc *procPtr = (Proc *)(info.objClientData); 128 call = (procPtr->cmdPtr->compileProc != TclCompileNoOp); 129 } 130 131 if (call) { 132 133 /* 134 * Do recording by eval'ing a tcl history command: history add $cmd. 135 */ 136 137 TclNewLiteralStringObj(list[0], "history"); 138 TclNewLiteralStringObj(list[1], "add"); 139 list[2] = cmdPtr; 140 141 objPtr = Tcl_NewListObj(3, list); 142 Tcl_IncrRefCount(objPtr); 143 (void) Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL); 144 Tcl_DecrRefCount(objPtr); 145 146 /* 147 * One possible failure mode above: exceeding a resource limit. 148 */ 149 150 if (Tcl_LimitExceeded(interp)) { 151 return TCL_ERROR; 152 } 153 } 154 155 /* 156 * Execute the command. 157 */ 158 159 result = TCL_OK; 160 if (!(flags & TCL_NO_EVAL)) { 161 result = Tcl_EvalObjEx(interp, cmdPtr, flags & TCL_EVAL_GLOBAL); 162 } 163 return result; 164} 165 166/* 167 * Local Variables: 168 * mode: c 169 * c-basic-offset: 4 170 * fill-column: 78 171 * End: 172 */ 173