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