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 | * 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 | |
---|
41 | int |
---|
42 | Tcl_RecordAndEval(interp, cmd, flags) |
---|
43 | Tcl_Interp *interp; /* Token for interpreter in which command |
---|
44 | * will be executed. */ |
---|
45 | 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 | TclNewObj(cmdPtr); |
---|
61 | TclInitStringRep(cmdPtr, cmd, length); |
---|
62 | Tcl_IncrRefCount(cmdPtr); |
---|
63 | |
---|
64 | result = Tcl_RecordAndEvalObj(interp, cmdPtr, flags); |
---|
65 | |
---|
66 | /* |
---|
67 | * Move the interpreter's object result to the string result, |
---|
68 | * then reset the object result. |
---|
69 | * FAILS IF OBJECT RESULT'S STRING REPRESENTATION CONTAINS NULLS. |
---|
70 | */ |
---|
71 | |
---|
72 | Tcl_SetResult(interp, |
---|
73 | TclGetStringFromObj(Tcl_GetObjResult(interp), (int *) NULL), |
---|
74 | TCL_VOLATILE); |
---|
75 | |
---|
76 | /* |
---|
77 | * Discard the Tcl object created to hold the command. |
---|
78 | */ |
---|
79 | |
---|
80 | Tcl_DecrRefCount(cmdPtr); |
---|
81 | } else { |
---|
82 | /* |
---|
83 | * An empty string. Just reset the interpreter's result. |
---|
84 | */ |
---|
85 | |
---|
86 | Tcl_ResetResult(interp); |
---|
87 | result = TCL_OK; |
---|
88 | } |
---|
89 | return result; |
---|
90 | } |
---|
91 | |
---|
92 | /* |
---|
93 | *---------------------------------------------------------------------- |
---|
94 | * |
---|
95 | * Tcl_RecordAndEvalObj -- |
---|
96 | * |
---|
97 | * This procedure adds the command held in its argument object to the |
---|
98 | * current list of recorded events and then executes the command by |
---|
99 | * calling Tcl_EvalObj. |
---|
100 | * |
---|
101 | * Results: |
---|
102 | * The return value is a standard Tcl return value, the result of |
---|
103 | * executing the command. |
---|
104 | * |
---|
105 | * Side effects: |
---|
106 | * The command is recorded and executed. |
---|
107 | * |
---|
108 | *---------------------------------------------------------------------- |
---|
109 | */ |
---|
110 | |
---|
111 | int |
---|
112 | Tcl_RecordAndEvalObj(interp, cmdPtr, flags) |
---|
113 | Tcl_Interp *interp; /* Token for interpreter in which command |
---|
114 | * will be executed. */ |
---|
115 | Tcl_Obj *cmdPtr; /* Points to object holding the command to |
---|
116 | * record and execute. */ |
---|
117 | int flags; /* Additional flags. TCL_NO_EVAL means |
---|
118 | * record only: don't execute the command. |
---|
119 | * TCL_EVAL_GLOBAL means use |
---|
120 | * Tcl_GlobalEvalObj instead of |
---|
121 | * Tcl_EvalObj. */ |
---|
122 | { |
---|
123 | Interp *iPtr = (Interp *) interp; |
---|
124 | int result; |
---|
125 | Tcl_Obj *list[3]; |
---|
126 | register Tcl_Obj *objPtr; |
---|
127 | |
---|
128 | /* |
---|
129 | * Do recording by eval'ing a tcl history command: history add $cmd. |
---|
130 | */ |
---|
131 | |
---|
132 | list[0] = Tcl_NewStringObj("history", -1); |
---|
133 | list[1] = Tcl_NewStringObj("add", -1); |
---|
134 | list[2] = cmdPtr; |
---|
135 | |
---|
136 | objPtr = Tcl_NewListObj(3, list); |
---|
137 | Tcl_IncrRefCount(objPtr); |
---|
138 | (void) Tcl_GlobalEvalObj(interp, objPtr); |
---|
139 | Tcl_DecrRefCount(objPtr); |
---|
140 | |
---|
141 | /* |
---|
142 | * Execute the command. |
---|
143 | */ |
---|
144 | |
---|
145 | result = TCL_OK; |
---|
146 | if (!(flags & TCL_NO_EVAL)) { |
---|
147 | iPtr->evalFlags = (flags & ~TCL_EVAL_GLOBAL); |
---|
148 | if (flags & TCL_EVAL_GLOBAL) { |
---|
149 | result = Tcl_GlobalEvalObj(interp, cmdPtr); |
---|
150 | } else { |
---|
151 | result = Tcl_EvalObj(interp, cmdPtr); |
---|
152 | } |
---|
153 | } |
---|
154 | return result; |
---|
155 | } |
---|