source: trunk/tcl/tclHistory.c@ 2

Last change on this file since 2 was 2, checked in by Pavel Demin, 16 years ago

first commit
File size: 4.0 KB
Line 
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.1 2008-06-04 13:58:06 demin Exp $
16 */
17
18#include "tclInt.h"
19#include "tclPort.h"
20
21
22
23/*
24 *----------------------------------------------------------------------
25 *
26 * Tcl_RecordAndEval --
27 *
28 * This procedure adds its command argument to the current list of
29 * recorded events and then executes the command by calling
30 * Tcl_Eval.
31 *
32 * Results:
33 * The return value is a standard Tcl return value, the result of
34 * executing cmd.
35 *
36 * Side effects:
37 * The command is recorded and executed.
38 *
39 *----------------------------------------------------------------------
40 */
41
42int
43Tcl_RecordAndEval(interp, cmd, flags)
44 Tcl_Interp *interp; /* Token for interpreter in which command
45 * will be executed. */
46 char *cmd; /* Command to record. */
47 int flags; /* Additional flags. TCL_NO_EVAL means
48 * only record: don't execute command.
49 * TCL_EVAL_GLOBAL means use Tcl_GlobalEval
50 * instead of Tcl_Eval. */
51{
52 register Tcl_Obj *cmdPtr;
53 int length = strlen(cmd);
54 int result;
55
56 if (length > 0) {
57 /*
58 * Call Tcl_RecordAndEvalObj to do the actual work.
59 */
60
61 TclNewObj(cmdPtr);
62 TclInitStringRep(cmdPtr, cmd, length);
63 Tcl_IncrRefCount(cmdPtr);
64
65 result = Tcl_RecordAndEvalObj(interp, cmdPtr, flags);
66
67 /*
68 * Move the interpreter's object result to the string result,
69 * then reset the object result.
70 * FAILS IF OBJECT RESULT'S STRING REPRESENTATION CONTAINS NULLS.
71 */
72
73 Tcl_SetResult(interp,
74 TclGetStringFromObj(Tcl_GetObjResult(interp), (int *) NULL),
75 TCL_VOLATILE);
76
77 /*
78 * Discard the Tcl object created to hold the command.
79 */
80
81 Tcl_DecrRefCount(cmdPtr);
82 } else {
83 /*
84 * An empty string. Just reset the interpreter's result.
85 */
86
87 Tcl_ResetResult(interp);
88 result = TCL_OK;
89 }
90 return result;
91}
92
93
94/*
95 *----------------------------------------------------------------------
96 *
97 * Tcl_RecordAndEvalObj --
98 *
99 * This procedure adds the command held in its argument object to the
100 * current list of recorded events and then executes the command by
101 * calling Tcl_EvalObj.
102 *
103 * Results:
104 * The return value is a standard Tcl return value, the result of
105 * executing the command.
106 *
107 * Side effects:
108 * The command is recorded and executed.
109 *
110 *----------------------------------------------------------------------
111 */
112
113int
114Tcl_RecordAndEvalObj(interp, cmdPtr, flags)
115 Tcl_Interp *interp; /* Token for interpreter in which command
116 * will be executed. */
117 Tcl_Obj *cmdPtr; /* Points to object holding the command to
118 * record and execute. */
119 int flags; /* Additional flags. TCL_NO_EVAL means
120 * record only: don't execute the command.
121 * TCL_EVAL_GLOBAL means use
122 * Tcl_GlobalEvalObj instead of
123 * Tcl_EvalObj. */
124{
125 Interp *iPtr = (Interp *) interp;
126 int result;
127 Tcl_Obj *list[3];
128 register Tcl_Obj *objPtr;
129
130 /*
131 * Do recording by eval'ing a tcl history command: history add $cmd.
132 */
133
134 list[0] = Tcl_NewStringObj("history", -1);
135 list[1] = Tcl_NewStringObj("add", -1);
136 list[2] = cmdPtr;
137
138 objPtr = Tcl_NewListObj(3, list);
139 Tcl_IncrRefCount(objPtr);
140 (void) Tcl_GlobalEvalObj(interp, objPtr);
141 Tcl_DecrRefCount(objPtr);
142
143 /*
144 * Execute the command.
145 */
146
147 result = TCL_OK;
148 if (!(flags & TCL_NO_EVAL)) {
149 iPtr->evalFlags = (flags & ~TCL_EVAL_GLOBAL);
150 if (flags & TCL_EVAL_GLOBAL) {
151 result = Tcl_GlobalEvalObj(interp, cmdPtr);
152 } else {
153 result = Tcl_EvalObj(interp, cmdPtr);
154 }
155 }
156 return result;
157}
Note: See TracBrowser for help on using the repository browser.