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 | |
---|
38 | int |
---|
39 | Tcl_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 | |
---|
103 | int |
---|
104 | Tcl_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 | */ |
---|