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
13 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
14 *
15 * RCS: @(#) $Id: tclHistory.c,v 1.4 2002/01/16 06:02:34 dgp Exp $
16 */
17
18#include "tclInt.h"
19#include "tclPort.h"
20
21
22/*
23 *----------------------------------------------------------------------
24 *
25 * Tcl_RecordAndEval --
26 *
27 *	This procedure adds its command argument to the current list of
28 *	recorded events and then executes the command by calling
29 *	Tcl_Eval.
30 *
31 * Results:
32 *	The return value is a standard Tcl return value, the result of
33 *	executing cmd.
34 *
35 * Side effects:
36 *	The command is recorded and executed.
37 *
38 *----------------------------------------------------------------------
39 */
40
41int
42Tcl_RecordAndEval(interp, cmd, flags)
43    Tcl_Interp *interp;		/* Token for interpreter in which command
44				 * will be executed. */
45    CONST char *cmd;		/* Command to record. */
46    int flags;			/* Additional flags.  TCL_NO_EVAL means
47				 * only record: don't execute command.
48				 * TCL_EVAL_GLOBAL means use Tcl_GlobalEval
49				 * instead of Tcl_Eval. */
50{
51    register Tcl_Obj *cmdPtr;
52    int length = strlen(cmd);
53    int result;
54
55    if (length > 0) {
56	/*
57	 * Call Tcl_RecordAndEvalObj to do the actual work.
58	 */
59
60	cmdPtr = Tcl_NewStringObj(cmd, length);
61	Tcl_IncrRefCount(cmdPtr);
62	result = Tcl_RecordAndEvalObj(interp, cmdPtr, flags);
63
64	/*
65	 * Move the interpreter's object result to the string result,
66	 * then reset the object result.
67	 */
68
69	Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
70	        TCL_VOLATILE);
71
72	/*
73	 * Discard the Tcl object created to hold the command.
74	 */
75
76	Tcl_DecrRefCount(cmdPtr);
77    } else {
78	/*
79	 * An empty string. Just reset the interpreter's result.
80	 */
81
82	Tcl_ResetResult(interp);
83	result = TCL_OK;
84    }
85    return result;
86}
87
88/*
89 *----------------------------------------------------------------------
90 *
91 * Tcl_RecordAndEvalObj --
92 *
93 *	This procedure adds the command held in its argument object to the
94 *	current list of recorded events and then executes the command by
95 *	calling Tcl_EvalObj.
96 *
97 * Results:
98 *	The return value is a standard Tcl return value, the result of
99 *	executing the command.
100 *
101 * Side effects:
102 *	The command is recorded and executed.
103 *
104 *----------------------------------------------------------------------
105 */
106
107int
108Tcl_RecordAndEvalObj(interp, cmdPtr, flags)
109    Tcl_Interp *interp;		/* Token for interpreter in which command
110				 * will be executed. */
111    Tcl_Obj *cmdPtr;		/* Points to object holding the command to
112				 * record and execute. */
113    int flags;			/* Additional flags. TCL_NO_EVAL means
114				 * record only: don't execute the command.
115				 * TCL_EVAL_GLOBAL means evaluate the
116				 * script in global variable context instead
117				 * of the current procedure. */
118{
119    int result;
120    Tcl_Obj *list[3];
121    register Tcl_Obj *objPtr;
122
123    /*
124     * Do recording by eval'ing a tcl history command: history add $cmd.
125     */
126
127    list[0] = Tcl_NewStringObj("history", -1);
128    list[1] = Tcl_NewStringObj("add", -1);
129    list[2] = cmdPtr;
130
131    objPtr = Tcl_NewListObj(3, list);
132    Tcl_IncrRefCount(objPtr);
133    (void) Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL);
134    Tcl_DecrRefCount(objPtr);
135
136    /*
137     * Execute the command.
138     */
139
140    result = TCL_OK;
141    if (!(flags & TCL_NO_EVAL)) {
142	result = Tcl_EvalObjEx(interp, cmdPtr, flags & TCL_EVAL_GLOBAL);
143    }
144    return result;
145}
146