]>
git.zerfleddert.de Git - micropolis/blob - src/tclx/src/tclxclp.c
4 * Interactive command loop, C and Tcl callable.
5 *-----------------------------------------------------------------------------
6 * Copyright 1992 Karl Lehenbauer and Mark Diekhans.
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
14 *-----------------------------------------------------------------------------
15 * $Id: tclXcmdloop.c,v 2.0 1992/10/16 04:50:29 markd Rel $
16 *-----------------------------------------------------------------------------
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.
29 int (*tclShellCmdEvalProc
) () = Tcl_Eval
;
32 * Prototypes of internal functions.
35 IsSetVarCmd
_ANSI_ARGS_((Tcl_Interp
*interp
,
39 OutFlush
_ANSI_ARGS_((FILE *filePtr
));
42 Tcl_PrintResult
_ANSI_ARGS_((FILE *fp
,
47 OutputPrompt
_ANSI_ARGS_((Tcl_Interp
*interp
,
52 SetPromptVar
_ANSI_ARGS_((Tcl_Interp
*interp
,
55 char **oldHookValuePtr
));
59 *-----------------------------------------------------------------------------
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.
67 *-----------------------------------------------------------------------------
70 IsSetVarCmd (interp
, command
)
76 if ((!STRNEQU (command
, "set", 3)) || (!isspace (command
[3])))
77 return FALSE
; /* Quick check */
79 nextPtr
= TclWordEnd (command
, FALSE
);
82 nextPtr
= TclWordEnd (nextPtr
, FALSE
);
86 while (*nextPtr
!= '\0') {
87 if (!isspace (*nextPtr
))
95 *-----------------------------------------------------------------------------
99 * Flush a stdio file and check for errors.
101 *-----------------------------------------------------------------------------
109 stat
= fflush (filePtr
);
110 if (ferror (filePtr
)) {
112 panic ("command loop: error writing to output file: %s\n",
119 *-----------------------------------------------------------------------------
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.
132 *-----------------------------------------------------------------------------
135 Tcl_PrintResult (fp
, returnval
, resultText
)
141 if (returnval
== TCL_OK
) {
142 if (resultText
[0] != '\0') {
143 fputs (resultText
, fp
);
148 fputs ((returnval
== TCL_ERROR
) ? "Error" : "Bad return code", stderr
);
149 fputs (": ", stderr
);
150 fputs (resultText
, stderr
);
151 fputs ("\n", stderr
);
157 *-----------------------------------------------------------------------------
160 * Outputs a prompt by executing either the command string in
161 * TCLENV(topLevelPromptHook) or TCLENV(downLevelPromptHook).
163 *-----------------------------------------------------------------------------
166 OutputPrompt (interp
, outFP
, topLevel
)
174 int promptDone
= FALSE
;
176 hookName
= topLevel
? "topLevelPromptHook"
177 : "downLevelPromptHook";
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
);
188 fputs (interp
->result
, outFP
);
203 *-----------------------------------------------------------------------------
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.
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 *-----------------------------------------------------------------------------
226 Tcl_CommandLoop (interp
, inFile
, outFile
, evalProc
, options
)
239 cmdBuf
= Tcl_CreateCmdBuf();
243 * If a signal came in, process it and drop any pending command.
245 if (tclReceivedSignal
) {
246 Tcl_CheckForSignal (interp
, TCL_OK
);
247 Tcl_DeleteCmdBuf(cmdBuf
);
248 cmdBuf
= Tcl_CreateCmdBuf();
252 * Output a prompt and input a command.
256 OutputPrompt (interp
, outFile
, topLevel
);
258 if (fgets (inputBuf
, sizeof (inputBuf
), inFile
) == NULL
) {
259 if (!feof(inFile
) && (errno
== EINTR
)) {
261 continue; /* Next command */
264 panic ("command loop: error on input file: %s\n",
268 cmd
= Tcl_AssembleCmd(cmdBuf
, inputBuf
);
272 continue; /* Next line */
275 * Finally have a complete command, go eval it and maybe output the
278 result
= (*evalProc
) (interp
, cmd
, 0, (char **)NULL
);
279 if (result
!= TCL_OK
|| !IsSetVarCmd (interp
, cmd
))
280 Tcl_PrintResult (outFile
, result
, interp
->result
);
284 Tcl_DeleteCmdBuf(cmdBuf
);
288 *-----------------------------------------------------------------------------
291 * Set one of the prompt hook variables, saving a copy of the old
292 * value, if it exists.
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.
303 * TCL_OK if the hook variable was set ok, TCL_ERROR if an error occured.
304 *-----------------------------------------------------------------------------
307 SetPromptVar (interp
, hookVarName
, newHookValue
, oldHookValuePtr
)
311 char **oldHookValuePtr
;
314 char *oldHookPtr
= NULL
;
316 if (oldHookValuePtr
!= NULL
) {
317 hookValue
= Tcl_GetVar2 (interp
, "TCLENV", hookVarName
,
319 if (hookValue
!= NULL
) {
320 oldHookPtr
= ckalloc (strlen (hookValue
) + 1);
321 strcpy (oldHookPtr
, hookValue
);
324 if (Tcl_SetVar2 (interp
, "TCLENV", hookVarName
, newHookValue
,
325 TCL_GLOBAL_ONLY
| TCL_LEAVE_ERR_MSG
) == NULL
) {
326 if (oldHookPtr
!= NULL
)
330 if (oldHookValuePtr
!= NULL
)
331 *oldHookValuePtr
= oldHookPtr
;
336 *-----------------------------------------------------------------------------
338 * Tcl_CommandloopCmd --
339 * Implements the TCL commandloop command:
340 * commandloop prompt prompt2
343 * Standard TCL results.
345 *-----------------------------------------------------------------------------
348 Tcl_CommandloopCmd(clientData
, interp
, argc
, argv
)
349 ClientData clientData
;
354 char *oldTopLevelHook
= NULL
;
355 char *oldDownLevelHook
= NULL
;
356 int result
= TCL_ERROR
;
359 Tcl_AppendResult (interp
, tclXWrongArgs
, argv
[0],
360 " [prompt] [prompt2]", (char *) NULL
);
364 if (SetPromptVar (interp
, "topLevelPromptHook", argv
[1],
365 &oldTopLevelHook
) != TCL_OK
)
369 if (SetPromptVar (interp
, "downLevelPromptHook", argv
[2],
370 &oldDownLevelHook
) != TCL_OK
)
374 Tcl_CommandLoop (interp
, stdin
, stdout
, tclShellCmdEvalProc
, 0);
376 if (oldTopLevelHook
!= NULL
)
377 SetPromptVar (interp
, "topLevelPromptHook", oldTopLevelHook
, NULL
);
378 if (oldDownLevelHook
!= NULL
)
379 SetPromptVar (interp
, "downLevelPromptHook", oldDownLevelHook
, NULL
);
383 if (oldTopLevelHook
!= NULL
)
384 ckfree (oldTopLevelHook
);
385 if (oldDownLevelHook
!= NULL
)
386 ckfree (oldDownLevelHook
);