]>
Commit | Line | Data |
---|---|---|
6a5fa4e0 MG |
1 | /* |
2 | * tclXcmdloop -- | |
3 | * | |
4 | * Interactive command loop, C and Tcl callable. | |
5 | *----------------------------------------------------------------------------- | |
6 | * Copyright 1992 Karl Lehenbauer and Mark Diekhans. | |
7 | * | |
8 | * Permission to use, copy, modify, and distribute this software and its | |
9 | * documentation for any purpose and without fee is hereby granted, provided | |
10 | * that the above copyright notice appear in all copies. Karl Lehenbauer and | |
11 | * Mark Diekhans make no representations about the suitability of this | |
12 | * software for any purpose. It is provided "as is" without express or | |
13 | * implied warranty. | |
14 | *----------------------------------------------------------------------------- | |
15 | * $Id: tclXcmdloop.c,v 2.0 1992/10/16 04:50:29 markd Rel $ | |
16 | *----------------------------------------------------------------------------- | |
17 | */ | |
18 | ||
19 | #include "tclxint.h" | |
20 | ||
21 | ||
22 | /* | |
23 | * Pointer to eval procedure to use. This way bring in the history module | |
24 | * from a library can be made optional. This only works because the calling | |
25 | * sequence of Tcl_Eval is a superset of Tcl_RecordAndEval. This defaults | |
26 | * to no history, set this variable to Tcl_RecordAndEval to use history. | |
27 | */ | |
28 | ||
29 | int (*tclShellCmdEvalProc) () = Tcl_Eval; | |
30 | ||
31 | /* | |
32 | * Prototypes of internal functions. | |
33 | */ | |
34 | static int | |
35 | IsSetVarCmd _ANSI_ARGS_((Tcl_Interp *interp, | |
36 | char *command)); | |
37 | ||
38 | static void | |
39 | OutFlush _ANSI_ARGS_((FILE *filePtr)); | |
40 | ||
41 | static void | |
42 | Tcl_PrintResult _ANSI_ARGS_((FILE *fp, | |
43 | int returnval, | |
44 | char *resultText)); | |
45 | ||
46 | static void | |
47 | OutputPrompt _ANSI_ARGS_((Tcl_Interp *interp, | |
48 | FILE *outFP, | |
49 | int topLevel)); | |
50 | ||
51 | static int | |
52 | SetPromptVar _ANSI_ARGS_((Tcl_Interp *interp, | |
53 | char *hookVarName, | |
54 | char *newHookValue, | |
55 | char **oldHookValuePtr)); | |
56 | ||
57 | \f | |
58 | /* | |
59 | *----------------------------------------------------------------------------- | |
60 | * | |
61 | * IsSetVarCmd -- | |
62 | * | |
63 | * Determine if the current command is a `set' command that set | |
64 | * a variable (i.e. two arguments). This routine should only be | |
65 | * called if the command returned TCL_OK. | |
66 | * | |
67 | *----------------------------------------------------------------------------- | |
68 | */ | |
69 | static int | |
70 | IsSetVarCmd (interp, command) | |
71 | Tcl_Interp *interp; | |
72 | char *command; | |
73 | { | |
74 | char *nextPtr; | |
75 | ||
76 | if ((!STRNEQU (command, "set", 3)) || (!isspace (command [3]))) | |
77 | return FALSE; /* Quick check */ | |
78 | ||
79 | nextPtr = TclWordEnd (command, FALSE); | |
80 | if (*nextPtr == '\0') | |
81 | return FALSE; | |
82 | nextPtr = TclWordEnd (nextPtr, FALSE); | |
83 | if (*nextPtr == '\0') | |
84 | return FALSE; | |
85 | ||
86 | while (*nextPtr != '\0') { | |
87 | if (!isspace (*nextPtr)) | |
88 | return TRUE; | |
89 | nextPtr++; | |
90 | } | |
91 | return FALSE; | |
92 | } | |
93 | \f | |
94 | /* | |
95 | *----------------------------------------------------------------------------- | |
96 | * | |
97 | * OutFlush -- | |
98 | * | |
99 | * Flush a stdio file and check for errors. | |
100 | * | |
101 | *----------------------------------------------------------------------------- | |
102 | */ | |
103 | static void | |
104 | OutFlush (filePtr) | |
105 | FILE *filePtr; | |
106 | { | |
107 | int stat; | |
108 | ||
109 | stat = fflush (filePtr); | |
110 | if (ferror (filePtr)) { | |
111 | if (errno != EINTR) | |
112 | panic ("command loop: error writing to output file: %s\n", | |
113 | strerror (errno)); | |
114 | clearerr (filePtr); | |
115 | } | |
116 | } | |
117 | \f | |
118 | /* | |
119 | *----------------------------------------------------------------------------- | |
120 | * | |
121 | * Tcl_PrintResult -- | |
122 | * | |
123 | * Print a Tcl result | |
124 | * | |
125 | * Results: | |
126 | * | |
127 | * Takes an open file pointer, a return value and some result | |
128 | * text. Prints the result text if the return value is TCL_OK, | |
129 | * prints "Error:" and the result text if it's TCL_ERROR, | |
130 | * else prints "Bad return code:" and the result text. | |
131 | * | |
132 | *----------------------------------------------------------------------------- | |
133 | */ | |
134 | static void | |
135 | Tcl_PrintResult (fp, returnval, resultText) | |
136 | FILE *fp; | |
137 | int returnval; | |
138 | char *resultText; | |
139 | { | |
140 | ||
141 | if (returnval == TCL_OK) { | |
142 | if (resultText [0] != '\0') { | |
143 | fputs (resultText, fp); | |
144 | fputs ("\n", fp); | |
145 | } | |
146 | } else { | |
147 | OutFlush (fp); | |
148 | fputs ((returnval == TCL_ERROR) ? "Error" : "Bad return code", stderr); | |
149 | fputs (": ", stderr); | |
150 | fputs (resultText, stderr); | |
151 | fputs ("\n", stderr); | |
152 | OutFlush (stderr); | |
153 | } | |
154 | } | |
155 | \f | |
156 | /* | |
157 | *----------------------------------------------------------------------------- | |
158 | * | |
159 | * OutputPromp -- | |
160 | * Outputs a prompt by executing either the command string in | |
161 | * TCLENV(topLevelPromptHook) or TCLENV(downLevelPromptHook). | |
162 | * | |
163 | *----------------------------------------------------------------------------- | |
164 | */ | |
165 | static void | |
166 | OutputPrompt (interp, outFP, topLevel) | |
167 | Tcl_Interp *interp; | |
168 | FILE *outFP; | |
169 | int topLevel; | |
170 | { | |
171 | char *hookName; | |
172 | char *promptHook; | |
173 | int result; | |
174 | int promptDone = FALSE; | |
175 | ||
176 | hookName = topLevel ? "topLevelPromptHook" | |
177 | : "downLevelPromptHook"; | |
178 | ||
179 | promptHook = Tcl_GetVar2 (interp, "TCLENV", hookName, 1); | |
180 | if ((promptHook != NULL) && (promptHook [0] != '\0')) { | |
181 | result = Tcl_Eval (interp, promptHook, 0, (char **)NULL); | |
182 | if (!((result == TCL_OK) || (result == TCL_RETURN))) { | |
183 | fputs ("Error in prompt hook: ", stderr); | |
184 | fputs (interp->result, stderr); | |
185 | fputs ("\n", stderr); | |
186 | Tcl_PrintResult (outFP, result, interp->result); | |
187 | } else { | |
188 | fputs (interp->result, outFP); | |
189 | promptDone = TRUE; | |
190 | } | |
191 | } | |
192 | if (!promptDone) { | |
193 | if (topLevel) | |
194 | fputs ("%", outFP); | |
195 | else | |
196 | fputs (">", outFP); | |
197 | } | |
198 | OutFlush (outFP); | |
199 | ||
200 | } | |
201 | \f | |
202 | /* | |
203 | *----------------------------------------------------------------------------- | |
204 | * | |
205 | * Tcl_CommandLoop -- | |
206 | * | |
207 | * Run a Tcl command loop. The command loop interactively prompts for, | |
208 | * reads and executes commands. Two entries in the global array TCLENV | |
209 | * contain prompt hooks. A prompt hook is Tcl code that is executed and | |
210 | * its result is used as the prompt string. The element `topLevelPromptHook' | |
211 | * is the hook that generates the main prompt. The element | |
212 | * `downLevelPromptHook' is the hook to generate the prompt for reading | |
213 | * continuation lines for incomplete commands. If a signal occurs while | |
214 | * in the command loop, it is reset and ignored. EOF terminates the loop. | |
215 | * | |
216 | * Parameters: | |
217 | * o interp (I) - A pointer to the interpreter | |
218 | * o inFile (I) - The file to read commands from. | |
219 | * o outFile (I) - The file to write the prompts to. | |
220 | * o evalProc (I) - The function to call to evaluate a command. | |
221 | * Should be either Tcl_Eval or Tcl_RecordAndEval if history is desired. | |
222 | * o options (I) - Currently unused. | |
223 | *----------------------------------------------------------------------------- | |
224 | */ | |
225 | void | |
226 | Tcl_CommandLoop (interp, inFile, outFile, evalProc, options) | |
227 | Tcl_Interp *interp; | |
228 | FILE *inFile; | |
229 | FILE *outFile; | |
230 | int (*evalProc) (); | |
231 | unsigned options; | |
232 | { | |
233 | Tcl_CmdBuf cmdBuf; | |
234 | char inputBuf[256]; | |
235 | int topLevel = TRUE; | |
236 | int result; | |
237 | char *cmd; | |
238 | ||
239 | cmdBuf = Tcl_CreateCmdBuf(); | |
240 | ||
241 | while (TRUE) { | |
242 | /* | |
243 | * If a signal came in, process it and drop any pending command. | |
244 | */ | |
245 | if (tclReceivedSignal) { | |
246 | Tcl_CheckForSignal (interp, TCL_OK); | |
247 | Tcl_DeleteCmdBuf(cmdBuf); | |
248 | cmdBuf = Tcl_CreateCmdBuf(); | |
249 | topLevel = TRUE; | |
250 | } | |
251 | /* | |
252 | * Output a prompt and input a command. | |
253 | */ | |
254 | clearerr (inFile); | |
255 | clearerr (outFile); | |
256 | OutputPrompt (interp, outFile, topLevel); | |
257 | errno = 0; | |
258 | if (fgets (inputBuf, sizeof (inputBuf), inFile) == NULL) { | |
259 | if (!feof(inFile) && (errno == EINTR)) { | |
260 | putchar('\n'); | |
261 | continue; /* Next command */ | |
262 | } | |
263 | if (ferror (inFile)) | |
264 | panic ("command loop: error on input file: %s\n", | |
265 | strerror (errno)); | |
266 | goto endOfFile; | |
267 | } | |
268 | cmd = Tcl_AssembleCmd(cmdBuf, inputBuf); | |
269 | ||
270 | if (cmd == NULL) { | |
271 | topLevel = FALSE; | |
272 | continue; /* Next line */ | |
273 | } | |
274 | /* | |
275 | * Finally have a complete command, go eval it and maybe output the | |
276 | * result. | |
277 | */ | |
278 | result = (*evalProc) (interp, cmd, 0, (char **)NULL); | |
279 | if (result != TCL_OK || !IsSetVarCmd (interp, cmd)) | |
280 | Tcl_PrintResult (outFile, result, interp->result); | |
281 | topLevel = TRUE; | |
282 | } | |
283 | endOfFile: | |
284 | Tcl_DeleteCmdBuf(cmdBuf); | |
285 | } | |
286 | \f | |
287 | /* | |
288 | *----------------------------------------------------------------------------- | |
289 | * | |
290 | * SetPromptVar -- | |
291 | * Set one of the prompt hook variables, saving a copy of the old | |
292 | * value, if it exists. | |
293 | * | |
294 | * Parameters: | |
295 | * o hookVarName (I) - The name of the prompt hook, which is an element | |
296 | * of the TCLENV array. One of topLevelPromptHook or downLevelPromptHook. | |
297 | * o newHookValue (I) - The new value for the prompt hook. | |
298 | * o oldHookValuePtr (O) - If not NULL, then a pointer to a copy of the | |
299 | * old prompt value is returned here. NULL is returned if there was not | |
300 | * old value. This is a pointer to a malloc-ed string that must be | |
301 | * freed when no longer needed. | |
302 | * Result: | |
303 | * TCL_OK if the hook variable was set ok, TCL_ERROR if an error occured. | |
304 | *----------------------------------------------------------------------------- | |
305 | */ | |
306 | static int | |
307 | SetPromptVar (interp, hookVarName, newHookValue, oldHookValuePtr) | |
308 | Tcl_Interp *interp; | |
309 | char *hookVarName; | |
310 | char *newHookValue; | |
311 | char **oldHookValuePtr; | |
312 | { | |
313 | char *hookValue; | |
314 | char *oldHookPtr = NULL; | |
315 | ||
316 | if (oldHookValuePtr != NULL) { | |
317 | hookValue = Tcl_GetVar2 (interp, "TCLENV", hookVarName, | |
318 | TCL_GLOBAL_ONLY); | |
319 | if (hookValue != NULL) { | |
320 | oldHookPtr = ckalloc (strlen (hookValue) + 1); | |
321 | strcpy (oldHookPtr, hookValue); | |
322 | } | |
323 | } | |
324 | if (Tcl_SetVar2 (interp, "TCLENV", hookVarName, newHookValue, | |
325 | TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG) == NULL) { | |
326 | if (oldHookPtr != NULL) | |
327 | ckfree (oldHookPtr); | |
328 | return TCL_ERROR; | |
329 | } | |
330 | if (oldHookValuePtr != NULL) | |
331 | *oldHookValuePtr = oldHookPtr; | |
332 | return TCL_OK; | |
333 | } | |
334 | \f | |
335 | /* | |
336 | *----------------------------------------------------------------------------- | |
337 | * | |
338 | * Tcl_CommandloopCmd -- | |
339 | * Implements the TCL commandloop command: | |
340 | * commandloop prompt prompt2 | |
341 | * | |
342 | * Results: | |
343 | * Standard TCL results. | |
344 | * | |
345 | *----------------------------------------------------------------------------- | |
346 | */ | |
347 | int | |
348 | Tcl_CommandloopCmd(clientData, interp, argc, argv) | |
349 | ClientData clientData; | |
350 | Tcl_Interp *interp; | |
351 | int argc; | |
352 | char **argv; | |
353 | { | |
354 | char *oldTopLevelHook = NULL; | |
355 | char *oldDownLevelHook = NULL; | |
356 | int result = TCL_ERROR; | |
357 | ||
358 | if (argc > 3) { | |
359 | Tcl_AppendResult (interp, tclXWrongArgs, argv[0], | |
360 | " [prompt] [prompt2]", (char *) NULL); | |
361 | return TCL_ERROR; | |
362 | } | |
363 | if (argc > 1) { | |
364 | if (SetPromptVar (interp, "topLevelPromptHook", argv[1], | |
365 | &oldTopLevelHook) != TCL_OK) | |
366 | goto exitPoint; | |
367 | } | |
368 | if (argc > 2) { | |
369 | if (SetPromptVar (interp, "downLevelPromptHook", argv[2], | |
370 | &oldDownLevelHook) != TCL_OK) | |
371 | goto exitPoint; | |
372 | } | |
373 | ||
374 | Tcl_CommandLoop (interp, stdin, stdout, tclShellCmdEvalProc, 0); | |
375 | ||
376 | if (oldTopLevelHook != NULL) | |
377 | SetPromptVar (interp, "topLevelPromptHook", oldTopLevelHook, NULL); | |
378 | if (oldDownLevelHook != NULL) | |
379 | SetPromptVar (interp, "downLevelPromptHook", oldDownLevelHook, NULL); | |
380 | ||
381 | result = TCL_OK; | |
382 | exitPoint: | |
383 | if (oldTopLevelHook != NULL) | |
384 | ckfree (oldTopLevelHook); | |
385 | if (oldDownLevelHook != NULL) | |
386 | ckfree (oldDownLevelHook); | |
387 | return result; | |
388 | } |