1 /*
2 * tclXcmdloop --
3 *
4 * Interactive command loop, C and Tcl callable.
5 *-----------------------------------------------------------------------------
6 * Copyright 1991-1999 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 1.3 2002/09/26 00:19:18 hobbs Exp $
16 *-----------------------------------------------------------------------------
17 */
18
19 #include "tclExtdInt.h"
20
21 /*
22 * Client data entry for asynchronous command reading. This is associated
23 * with a given instance of a async command loop. I allows for recursive
24 * commands loops on the same channel (and even multiple, but the results
25 * out be unpredicatable).
26 */
27 typedef struct {
28 Tcl_Interp *interp; /* Interp for command eval. */
29 Tcl_Channel channel; /* Input channel. */
30 int options; /* Command loop options. */
31 Tcl_DString command; /* Buffer for command being read. */
32 int partial; /* Partial command in buffer? */
33 char *endCommand; /* Command to execute at end of loop. */
34 char *prompt1; /* Prompts to use. */
35 char *prompt2;
36 } asyncLoopData_t;
37
38
39 /*
40 * Prototypes of internal functions.
41 */
42 static int
43 IsSetVarCmd _ANSI_ARGS_((char *command));
44
45 static void
46 OutputPrompt _ANSI_ARGS_((Tcl_Interp *interp,
47 int topLevel,
48 char *prompt1,
49 char *prompt2));
50
51 static int
52 AsyncSignalErrorHandler _ANSI_ARGS_((Tcl_Interp *interp,
53 ClientData clientData,
54 int background,
55 int signalNum));
56
57
58 static void
59 AsyncCommandHandler _ANSI_ARGS_((ClientData clientData,
60 int mask));
61
62 static int
63 SyncSignalErrorHandler _ANSI_ARGS_((Tcl_Interp *interp,
64 ClientData clientData,
65 int background,
66 int signalNum));
67
68 static void
69 AsyncCommandHandlerDelete _ANSI_ARGS_((ClientData clientData));
70
71 static int
72 TclX_CommandloopObjCmd _ANSI_ARGS_((ClientData clientData,
73 Tcl_Interp *interp,
74 int objc,
75 Tcl_Obj *CONST objv[]));
76
77 /*-----------------------------------------------------------------------------
78 * IsSetVarCmd --
79 * Determine if a command is a `set' command that sets a variable
80 * (i.e. two arguments).
81 *
82 * Parameters:
83 * o command (I) - Command to check.
84 * Returns:
85 * TRUE if it is a set that sets a variable, FALSE if its some other command.
86 *-----------------------------------------------------------------------------
87 */
88 static int
IsSetVarCmd(command)89 IsSetVarCmd (command)
90 char *command;
91 {
92 Tcl_Parse tclParse;
93 int numWords;
94
95 if ((!STRNEQU (command, "set", 3)) || (!ISSPACE (command [3])))
96 return FALSE; /* Quick check */
97
98 Tcl_ParseCommand(NULL, command, -1, 1, &tclParse);
99 numWords = tclParse.numWords;
100 Tcl_FreeParse(&tclParse);
101 return numWords > 2 ? TRUE : FALSE;
102 }
103
104 /*-----------------------------------------------------------------------------
105 * TclX_PrintResult --
106 * Print the result of a Tcl_Eval. It can optionally not echo "set" commands
107 * that successfully set a variable.
108 *
109 * Parameters:
110 * o interp (I) - A pointer to the interpreter. Result of command should be
111 * in interp result.
112 * o intResult (I) - The integer result returned by Tcl_Eval.
113 * o checkCmd (I) - If not NULL and the command was sucessful, check to
114 * set if this is a "set" command setting a variable. If so, don't echo
115 * the result.
116 *-----------------------------------------------------------------------------
117 */
118 void
TclX_PrintResult(interp,intResult,checkCmd)119 TclX_PrintResult (interp, intResult, checkCmd)
120 Tcl_Interp *interp;
121 int intResult;
122 char *checkCmd;
123 {
124 Tcl_Channel stdoutChan, stderrChan;
125 char *resultStr;
126
127 /*
128 * If the command was supplied and it was a successful set of a variable,
129 * don't output the result.
130 */
131 if ((checkCmd != NULL) && (intResult == TCL_OK) && IsSetVarCmd (checkCmd))
132 return;
133
134 stdoutChan = Tcl_GetStdChannel(TCL_STDOUT);
135 stderrChan = Tcl_GetStdChannel(TCL_STDERR);
136
137 if (intResult == TCL_OK) {
138 if (stdoutChan == NULL)
139 return;
140 resultStr = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), NULL);
141 if (resultStr [0] != '\0') {
142 if (stderrChan != NULL)
143 Tcl_Flush (stderrChan);
144 Tcl_WriteChars(stdoutChan, resultStr, -1);
145 TclX_WriteNL(stdoutChan);
146 Tcl_Flush(stdoutChan);
147 }
148 } else {
149 char msg [64];
150
151 if (stderrChan == NULL)
152 return;
153 if (stdoutChan != NULL)
154 Tcl_Flush (stdoutChan);
155
156 if (intResult == TCL_ERROR) {
157 strcpy(msg, "Error: ");
158 } else {
159 sprintf(msg, "Bad return code (%d): ", intResult);
160 }
161 resultStr = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), NULL);
162 Tcl_WriteChars(stderrChan, msg, -1);
163 Tcl_WriteChars(stderrChan, resultStr, -1);
164 TclX_WriteNL(stderrChan);
165 Tcl_Flush(stderrChan);
166 }
167 }
168
169 /*-----------------------------------------------------------------------------
170 * OutputPrompt --
171 * Outputs a prompt by executing either the command string in tcl_prompt1 or
172 * tcl_prompt2 or a specified prompt string. Also involkes any pending async
173 * handlers, as these need to be done before the eval of the prompt, or they
174 * might result in an error in the prompt.
175 *
176 * Parameters:
177 * o interp (I) - A pointer to the interpreter.
178 * o topLevel (I) - If TRUE, output the top level prompt (tcl_prompt1).
179 * o prompt1 (I) - If not NULL, use this command instead of the value of
180 * tcl_prompt1. In this case, the result of the command is used rather
181 * than the output.
182 * o prompt2 (I) - If not NULL, use this command instead of the value of
183 * tcl_prompt2. In this case, the result of the command is used rather
184 * than the output.
185 *-----------------------------------------------------------------------------
186 */
187 static void
OutputPrompt(interp,topLevel,prompt1,prompt2)188 OutputPrompt (interp, topLevel, prompt1, prompt2)
189 Tcl_Interp *interp;
190 int topLevel;
191 char *prompt1;
192 char *prompt2;
193 {
194 char *promptHook;
195 char *resultStr;
196 int result, useResult, promptDone = FALSE;
197 Tcl_Channel stdoutChan, stderrChan;
198
199 stdoutChan = Tcl_GetStdChannel (TCL_STDOUT);
200 stderrChan = Tcl_GetStdChannel (TCL_STDERR);
201
202 /*
203 * If a signal came in, process it. This prevents signals that are queued
204 * from generating prompt hook errors.
205 */
206 if (Tcl_AsyncReady ()) {
207 Tcl_AsyncInvoke (interp, TCL_OK);
208 }
209
210 if (stderrChan != NULL)
211 Tcl_Flush (stderrChan);
212
213 /*
214 * Determine prompt command to evaluate.
215 */
216 if (topLevel) {
217 if (prompt1 != NULL) {
218 promptHook = prompt1;
219 useResult = TRUE;
220 } else {
221 promptHook = (char *) Tcl_GetVar (interp, "tcl_prompt1",
222 TCL_GLOBAL_ONLY);
223 useResult = FALSE;
224 }
225 } else {
226 if (prompt2 != NULL) {
227 promptHook = prompt2;
228 useResult = TRUE;
229 } else {
230 promptHook = (char *) Tcl_GetVar (interp, "tcl_prompt2",
231 TCL_GLOBAL_ONLY);
232 useResult = FALSE;
233 }
234 }
235
236 if (promptHook != NULL) {
237 result = Tcl_Eval (interp, promptHook);
238 resultStr = Tcl_GetStringFromObj (Tcl_GetObjResult (interp), NULL);
239 if (result == TCL_ERROR) {
240 if (stderrChan != NULL) {
241 Tcl_WriteChars(stderrChan, "Error in prompt hook: ", -1);
242 Tcl_WriteChars(stderrChan, resultStr, -1);
243 TclX_WriteNL (stderrChan);
244 }
245 } else {
246 if (useResult && (stdoutChan != NULL))
247 Tcl_WriteChars(stdoutChan, resultStr, -1);
248 promptDone = TRUE;
249 }
250 }
251
252 if (stdoutChan != NULL) {
253 if (!promptDone)
254 Tcl_Write (stdoutChan, topLevel ? "%" : ">", 1);
255 Tcl_Flush (stdoutChan);
256 }
257 Tcl_ResetResult (interp);
258 }
259
260 /*-----------------------------------------------------------------------------
261 * AsyncSignalErrorHandler --
262 * Handler for signals that generate errors. If no code is currently
263 * executing (i.e, it the event loop), we want the input buffer to be
264 * cleared on SIGINT.
265 *
266 * Parameters:
267 * o interp (I) - The interpreter used to process the signal. The error
268 * message is in the result.
269 * o clientData (I) - Pointer to the asyncLoopData structure.
270 * o background (I) - TRUE if signal was handled in the background (i.e
271 * the event loop) rather than in an interp.
272 * Returns:
273 * The Tcl result code to continue with. TCL_OK if we have handled the
274 * signal, TCL_ERROR if not.
275 *-----------------------------------------------------------------------------
276 */
277 static int
AsyncSignalErrorHandler(interp,clientData,background,signalNum)278 AsyncSignalErrorHandler (interp, clientData, background, signalNum)
279 Tcl_Interp *interp;
280 ClientData clientData;
281 int background;
282 int signalNum;
283 {
284 if (background & (signalNum == SIGINT)) {
285 asyncLoopData_t *dataPtr = (asyncLoopData_t *) clientData;
286 Tcl_Channel stdoutChan = Tcl_GetStdChannel (TCL_STDOUT);
287
288 Tcl_DStringFree (&dataPtr->command);
289 dataPtr->partial = FALSE;
290
291 Tcl_ResetResult (interp);
292
293 if (dataPtr->options & TCLX_CMDL_INTERACTIVE) {
294 if (stdoutChan != NULL)
295 TclX_WriteNL (stdoutChan);
296 OutputPrompt (dataPtr->interp, !dataPtr->partial,
297 dataPtr->prompt1, dataPtr->prompt2);
298 }
299 return TCL_OK;
300 }
301 return TCL_ERROR;
302 }
303
304 /*-----------------------------------------------------------------------------
305 * AsyncCommandHandler --
306 * Handler for async command reading. This procedure is invoked by the event
307 * dispatcher whenever the input becomes readable. It grabs the next line of
308 * input characters, adds them to a command being assembled, and executes the
309 * command if it's complete.
310 *
311 * Parameters:
312 * o clientData (I) - Pointer to the asyncLoopData structure.
313 * o mask (I) - Not used.
314 *-----------------------------------------------------------------------------
315 */
316 static void
AsyncCommandHandler(clientData,mask)317 AsyncCommandHandler (clientData, mask)
318 ClientData clientData;
319 int mask;
320 {
321 asyncLoopData_t *dataPtr = (asyncLoopData_t *) clientData;
322 int code;
323 char *cmd, *resultStr;
324
325 /*
326 * Make sure that we are the current signal error handler. This
327 * handles recusive event loop calls.
328 */
329 TclX_SetAppSignalErrorHandler (AsyncSignalErrorHandler, clientData);
330
331 if (Tcl_Gets (dataPtr->channel, &dataPtr->command) < 0) {
332 /*
333 * Handler EINTR error special.
334 */
335 if (!(Tcl_Eof (dataPtr->channel) ||
336 Tcl_InputBlocked (dataPtr->channel)) &&
337 (Tcl_GetErrno () == EINTR)) {
338 if (Tcl_AsyncReady ()) {
339 Tcl_AsyncInvoke (NULL, TCL_OK);
340 }
341 return; /* Let the event loop call us again. */
342 }
343
344 /*
345 * Handle EOF or error.
346 */
347 if (dataPtr->options & TCLX_CMDL_EXIT_ON_EOF) {
348 Tcl_Exit (0);
349 } else {
350 AsyncCommandHandlerDelete (clientData);
351 }
352 return;
353 }
354
355 cmd = Tcl_DStringAppend (&dataPtr->command, "\n", -1);
356
357 if (!Tcl_CommandComplete (cmd)) {
358 dataPtr->partial = TRUE;
359 goto prompt;
360 }
361 dataPtr->partial = FALSE;
362
363 /*
364 * Disable the stdin channel handler while evaluating the command;
365 * otherwise if the command re-enters the event loop we might process
366 * commands from stdin before the current command is finished. Among
367 * other things, this will trash the text of the command being evaluated.
368 */
369
370 Tcl_CreateChannelHandler (dataPtr->channel, 0,
371 AsyncCommandHandler, clientData);
372 code = Tcl_RecordAndEval (dataPtr->interp, cmd, TCL_EVAL_GLOBAL);
373 Tcl_CreateChannelHandler (dataPtr->channel, TCL_READABLE,
374 AsyncCommandHandler, clientData);
375
376 resultStr = Tcl_GetStringFromObj (Tcl_GetObjResult (dataPtr->interp),
377 NULL);
378 if (resultStr [0] != '\0') {
379 if (dataPtr->options & TCLX_CMDL_INTERACTIVE) {
380 TclX_PrintResult (dataPtr->interp, code, cmd);
381 }
382 }
383 Tcl_DStringFree (&dataPtr->command);
384
385 /*
386 * Output a prompt.
387 */
388 prompt:
389 if (dataPtr->options & TCLX_CMDL_INTERACTIVE) {
390 OutputPrompt (dataPtr->interp, !dataPtr->partial,
391 dataPtr->prompt1, dataPtr->prompt2);
392 }
393 Tcl_ResetResult (dataPtr->interp);
394 }
395
396 /*-----------------------------------------------------------------------------
397 * AsyncCommandHandlerDelete --
398 * Delete an async command handler.
399 *
400 * Parameters:
401 * o clientData (I) - Pointer to the asyncLoopData structure for the
402 * handler being deleted.
403 *-----------------------------------------------------------------------------
404 */
405 static void
AsyncCommandHandlerDelete(clientData)406 AsyncCommandHandlerDelete (clientData)
407 ClientData clientData;
408 {
409 asyncLoopData_t *dataPtr = (asyncLoopData_t *) clientData;
410
411 /*
412 * Remove handlers from system.
413 */
414 Tcl_DeleteChannelHandler (dataPtr->channel, AsyncCommandHandler,
415 clientData);
416 Tcl_DeleteCloseHandler (dataPtr->channel, AsyncCommandHandlerDelete,
417 clientData);
418 TclX_SetAppSignalErrorHandler (NULL, NULL);
419
420 /*
421 * If there is an end command, eval it.
422 */
423 if (dataPtr->endCommand != NULL) {
424 if (Tcl_GlobalEval (dataPtr->interp, dataPtr->endCommand) != TCL_OK)
425 Tcl_BackgroundError (dataPtr->interp);
426 Tcl_ResetResult (dataPtr->interp);
427 }
428
429 /*
430 * Free resources.
431 */
432 Tcl_DStringFree (&dataPtr->command);
433 if (dataPtr->endCommand != NULL)
434 ckfree (dataPtr->endCommand);
435 if (dataPtr->prompt1 != NULL)
436 ckfree (dataPtr->prompt1);
437 if (dataPtr->prompt2 != NULL)
438 ckfree (dataPtr->prompt2);
439 ckfree ((char *) dataPtr);
440 }
441
442 /*-----------------------------------------------------------------------------
443 * TclX_AsyncCommandLoop --
444 * Establish an async command handler on stdin.
445 *
446 * Parameters:
447 * o interp (I) - A pointer to the interpreter
448 * o options (I) - Async command loop options:
449 * o TCLX_CMDL_INTERACTIVE - Print a prompt and the result of command
450 * execution.
451 * o TCLX_CMDL_EXIT_ON_EOF - Exit when an EOF is encountered.
452 * o endCommand (I) - If not NULL, a command to evaluate when the command
453 * handler is removed, either by closing the channel or hitting EOF.
454 * o prompt1 (I) - If not NULL, the command to evalute get the main prompt.
455 * If NULL, the current value of tcl_prompt1 is evaluted to output the
456 * main prompt. NOTE: prompt1 returns a result while tcl_prompt1
457 * outputs a result.
458 * o prompt2 (I) - If not NULL, the command to evalute get the secondary
459 * prompt. If NULL, the current value of tcl_prompt is evaluted to
460 * output the secondary prompt. NOTE: prompt2 returns a result while
461 * tcl_prompt2 outputs a result.
462 * Returns:
463 * TCL_OK or TCL_ERROR;
464 *-----------------------------------------------------------------------------
465 */
466 int
TclX_AsyncCommandLoop(interp,options,endCommand,prompt1,prompt2)467 TclX_AsyncCommandLoop (interp, options, endCommand, prompt1, prompt2)
468 Tcl_Interp *interp;
469 int options;
470 char *endCommand;
471 char *prompt1;
472 char *prompt2;
473 {
474 Tcl_Channel stdinChan;
475 asyncLoopData_t *dataPtr;
476
477 stdinChan = TclX_GetOpenChannel (interp, "stdin", TCL_READABLE);
478 if (stdinChan == NULL)
479 return TCL_ERROR;
480
481 dataPtr = (asyncLoopData_t *) ckalloc (sizeof (asyncLoopData_t));
482
483 dataPtr->interp = interp;
484 dataPtr->channel = stdinChan;
485 dataPtr->options = options;
486 Tcl_DStringInit (&dataPtr->command);
487 dataPtr->partial = FALSE;
488 if (endCommand == NULL)
489 dataPtr->endCommand = NULL;
490 else
491 dataPtr->endCommand = ckstrdup (endCommand);
492 if (prompt1 == NULL)
493 dataPtr->prompt1 = NULL;
494 else
495 dataPtr->prompt1 = ckstrdup (prompt1);
496 if (prompt2 == NULL)
497 dataPtr->prompt2 = NULL;
498 else
499 dataPtr->prompt2 = ckstrdup (prompt2);
500
501 Tcl_DeleteCloseHandler (stdinChan, AsyncCommandHandlerDelete,
502 (ClientData) dataPtr);
503 Tcl_CreateChannelHandler (stdinChan, TCL_READABLE,
504 AsyncCommandHandler, (ClientData) dataPtr);
505 TclX_SetAppSignalErrorHandler (AsyncSignalErrorHandler,
506 (ClientData) dataPtr);
507
508 /*
509 * Output initial prompt.
510 */
511 if (dataPtr->options & TCLX_CMDL_INTERACTIVE) {
512 OutputPrompt (dataPtr->interp, !dataPtr->partial,
513 dataPtr->prompt1, dataPtr->prompt2);
514 }
515 return TCL_OK;
516 }
517
518 /*-----------------------------------------------------------------------------
519 * SyncSignalErrorHandler --
520 * Handler for signals that generate errors. We want to clear the input
521 * buffer on SIGINT.
522 *
523 * Parameters:
524 * o interp (I) - The interpreter used to process the signal. The error
525 * message is in the result.
526 * o clientData (I) - Pointer to a int to set to TRUE if SIGINT occurs.
527 * o background (I) - Ignored.
528 * Returns:
529 * The Tcl result code to continue with. TCL_OK if we have handled the
530 * signal, TCL_ERROR if not.
531 *-----------------------------------------------------------------------------
532 */
533 static int
SyncSignalErrorHandler(interp,clientData,background,signalNum)534 SyncSignalErrorHandler (interp, clientData, background, signalNum)
535 Tcl_Interp *interp;
536 ClientData clientData;
537 int background;
538 int signalNum;
539 {
540 if (signalNum == SIGINT) {
541 *((int *) clientData) = TRUE;
542 }
543 return TCL_ERROR;
544 }
545
546 /*-----------------------------------------------------------------------------
547 * TclX_CommandLoop --
548 * Run a syncronous Tcl command loop. EOF terminates the loop.
549 *
550 * Parameters:
551 * o interp (I) - A pointer to the interpreter
552 * o options (I) - Command loop options:
553 * o TCLX_CMDL_INTERACTIVE - Print a prompt and the result of command
554 * execution.
555 * o prompt1 (I) - If not NULL, the command to evalute get the main prompt.
556 * If NULL, the current value of tcl_prompt1 is evaluted to output the
557 * main prompt. NOTE: prompt1 returns a result while tcl_prompt1
558 * outputs a result.
559 * o prompt2 (I) - If not NULL, the command to evalute get the secondary
560 * prompt. If NULL, the current value of tcl_prompt is evaluted to
561 * output the secondary prompt. NOTE: prompt2 returns a result while
562 * tcl_prompt2 outputs a result.
563 * Returns:
564 * TCL_OK or TCL_ERROR;
565 *-----------------------------------------------------------------------------
566 */
567 int
TclX_CommandLoop(interp,options,endCommand,prompt1,prompt2)568 TclX_CommandLoop (interp, options, endCommand, prompt1, prompt2)
569 Tcl_Interp *interp;
570 int options;
571 char *endCommand;
572 char *prompt1;
573 char *prompt2;
574 {
575 Tcl_DString command;
576 int result, partial = FALSE, gotSigIntError = FALSE,
577 gotInterrupted = FALSE;
578 Tcl_Channel stdinChan, stdoutChan;
579
580 Tcl_DStringInit (&command);
581
582 while (TRUE) {
583 /*
584 * Always set signal error handler so recursive command loops work.
585 */
586 TclX_SetAppSignalErrorHandler (SyncSignalErrorHandler,
587 &gotSigIntError);
588
589 /*
590 * If a signal handlers are pending, process them.
591 */
592 if (Tcl_AsyncReady ()) {
593 result = Tcl_AsyncInvoke (interp, TCL_OK);
594 if ((result != TCL_OK) && !gotSigIntError)
595 TclX_PrintResult (interp, result, NULL);
596 }
597
598 /*
599 * Drop any pending command if SIGINT occured since the last time we
600 * were through here, event if its already been processed.
601 */
602 if (gotSigIntError) {
603 Tcl_DStringFree (&command);
604 partial = FALSE;
605 stdoutChan = Tcl_GetStdChannel (TCL_STDOUT);
606 if (stdoutChan != NULL)
607 TclX_WriteNL (stdoutChan);
608 }
609
610 /*
611 * Output a prompt and input a command.
612 */
613 stdinChan = Tcl_GetStdChannel (TCL_STDIN);
614 if (stdinChan == NULL)
615 goto endOfFile;
616
617 /*
618 * Only ouput prompt if we didn't get interrupted or if the
619 * interruption was SIGINT
620 */
621 if ((options & TCLX_CMDL_INTERACTIVE) &&
622 (!gotInterrupted || gotSigIntError)) {
623 OutputPrompt (interp, !partial, prompt1, prompt2);
624 }
625
626 /*
627 * Reset these flags for the next round
628 */
629 gotSigIntError = FALSE;
630 gotInterrupted = FALSE;
631
632 result = Tcl_Gets (stdinChan, &command);
633 if (result < 0) {
634 if (Tcl_Eof (stdinChan) || Tcl_InputBlocked (stdinChan))
635 goto endOfFile;
636 if (Tcl_GetErrno () == EINTR) {
637 gotInterrupted = TRUE;
638 continue; /* Process signals above */
639 }
640 TclX_AppendObjResult (interp, "command input error on stdin: ",
641 Tcl_PosixError (interp), (char *) NULL);
642 return TCL_ERROR;
643 }
644
645 /*
646 * Newline was stripped by Tcl_DStringGets, but is needed for
647 * command-complete checking, add it back in. If the command is
648 * not complete, get the next line.
649 */
650 Tcl_DStringAppend (&command, "\n", 1);
651
652 if (!Tcl_CommandComplete (command.string)) {
653 partial = TRUE;
654 continue; /* Next line */
655 }
656
657 /*
658 * Finally have a complete command, go eval it and maybe output the
659 * result.
660 */
661 result = Tcl_RecordAndEval (interp, command.string, 0);
662
663 if ((options & TCLX_CMDL_INTERACTIVE) || (result != TCL_OK))
664 TclX_PrintResult (interp, result, command.string);
665
666 partial = FALSE;
667 Tcl_DStringFree (&command);
668 }
669 endOfFile:
670 Tcl_DStringFree (&command);
671 if (endCommand != NULL) {
672 if (Tcl_Eval (interp, endCommand) == TCL_ERROR) {
673 return TCL_ERROR;
674 }
675 }
676 return TCL_OK;
677 }
678
679 /*-----------------------------------------------------------------------------
680 * Tcl_CommandloopObjCmd --
681 * Implements the commandloop command:
682 * commandloop -async -interactive on|off|tty -prompt1 cmd
683 * -prompt2 cmd -endcommand cmd
684 * Results:
685 * Standard TCL results.
686 *-----------------------------------------------------------------------------
687 */
688 static int
TclX_CommandloopObjCmd(clientData,interp,objc,objv)689 TclX_CommandloopObjCmd (clientData, interp, objc, objv)
690 ClientData clientData;
691 Tcl_Interp *interp;
692 int objc;
693 Tcl_Obj *CONST objv[];
694 {
695 int options = 0, async = FALSE, argIdx, interactive;
696 char *argStr, *endCommand = NULL;
697 char *prompt1 = NULL, *prompt2 = NULL;
698
699 interactive = isatty (0);
700 for (argIdx = 1; argIdx < objc; argIdx++) {
701 argStr = Tcl_GetStringFromObj (objv [argIdx], NULL);
702 if (argStr [0] != '-')
703 break;
704 if (STREQU (argStr, "-async")) {
705 async = TRUE;
706 } else if (STREQU (argStr, "-prompt1")) {
707 if (argIdx == objc - 1)
708 goto argRequired;
709 prompt1 = Tcl_GetStringFromObj (objv [++argIdx], NULL);;
710 } else if (STREQU (argStr, "-prompt2")) {
711 if (argIdx == objc - 1)
712 goto argRequired;
713 prompt2 = Tcl_GetStringFromObj (objv [++argIdx], NULL);
714 } else if (STREQU (argStr, "-interactive")) {
715 if (argIdx == objc - 1)
716 goto argRequired;
717 argIdx++;
718 argStr = Tcl_GetStringFromObj (objv [argIdx], NULL);
719 if (STREQU (argStr, "tty")) {
720 interactive = TRUE;
721 } else {
722 if (Tcl_GetBooleanFromObj (interp, objv [argIdx],
723 &interactive) != TCL_OK)
724 return TCL_ERROR;
725 }
726 } else if (STREQU (argStr, "-endcommand")) {
727 if (argIdx == objc - 1)
728 goto argRequired;
729 endCommand = Tcl_GetStringFromObj (objv [++argIdx], NULL);
730 } else {
731 goto unknownOption;
732 }
733 }
734 if (argIdx != objc)
735 goto wrongArgs;
736
737 if (interactive)
738 options |= TCLX_CMDL_INTERACTIVE;
739
740 if (async) {
741 return TclX_AsyncCommandLoop (interp,
742 options,
743 endCommand,
744 prompt1,
745 prompt2);
746 } else {
747 return TclX_CommandLoop (interp,
748 options,
749 endCommand,
750 prompt1,
751 prompt2);
752 }
753
754
755 /*
756 * Argument error message generation. argStr should contain the
757 * option being processed.
758 */
759 argRequired:
760 TclX_AppendObjResult (interp, "argument required for ", argStr,
761 " option", (char *) NULL);
762 return TCL_ERROR;
763
764 unknownOption:
765 TclX_AppendObjResult (interp, "unknown option \"", argStr,
766 "\", expected one of \"-async\", ",
767 "\"-interactive\", \"-prompt1\", \"-prompt2\", ",
768 " or \"-endcommand\"", (char *) NULL);
769 return TCL_ERROR;
770
771 wrongArgs:
772 TclX_WrongArgs (interp, objv [0],
773 "?-async? ?-interactive on|off|tty? ?-prompt1 cmd? ?-prompt2 cmd? ?-endcommand cmd?");
774 return TCL_ERROR;
775 }
776
777 /*-----------------------------------------------------------------------------
778 * TclX_CmdloopInit --
779 * Initialize the coommandloop command.
780 *-----------------------------------------------------------------------------
781 */
782 void
TclX_CmdloopInit(interp)783 TclX_CmdloopInit (interp)
784 Tcl_Interp *interp;
785 {
786 Tcl_CreateObjCommand (interp,
787 "commandloop",
788 TclX_CommandloopObjCmd,
789 (ClientData) NULL,
790 (Tcl_CmdDeleteProc*) NULL);
791
792 }
793
794