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 */ 27typedef 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 */ 42static int 43IsSetVarCmd _ANSI_ARGS_((char *command)); 44 45static void 46OutputPrompt _ANSI_ARGS_((Tcl_Interp *interp, 47 int topLevel, 48 char *prompt1, 49 char *prompt2)); 50 51static int 52AsyncSignalErrorHandler _ANSI_ARGS_((Tcl_Interp *interp, 53 ClientData clientData, 54 int background, 55 int signalNum)); 56 57 58static void 59AsyncCommandHandler _ANSI_ARGS_((ClientData clientData, 60 int mask)); 61 62static int 63SyncSignalErrorHandler _ANSI_ARGS_((Tcl_Interp *interp, 64 ClientData clientData, 65 int background, 66 int signalNum)); 67 68static void 69AsyncCommandHandlerDelete _ANSI_ARGS_((ClientData clientData)); 70 71static int 72TclX_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 */ 88static int 89IsSetVarCmd (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 */ 118void 119TclX_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 */ 187static void 188OutputPrompt (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 */ 277static int 278AsyncSignalErrorHandler (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 */ 316static void 317AsyncCommandHandler (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 */ 405static void 406AsyncCommandHandlerDelete (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 */ 466int 467TclX_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 */ 533static int 534SyncSignalErrorHandler (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 */ 567int 568TclX_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 */ 688static int 689TclX_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 */ 782void 783TclX_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