1/* 2 * tclMain.c -- 3 * 4 * Main program for Tcl shells and other Tcl-based applications. 5 * 6 * Copyright (c) 1988-1994 The Regents of the University of California. 7 * Copyright (c) 1994-1997 Sun Microsystems, Inc. 8 * Copyright (c) 2000 Ajuba Solutions. 9 * 10 * See the file "license.terms" for information on usage and redistribution of 11 * this file, and for a DISCLAIMER OF ALL WARRANTIES. 12 * 13 * RCS: @(#) $Id: tclMain.c,v 1.44 2007/12/13 15:23:19 dgp Exp $ 14 */ 15 16#include "tclInt.h" 17 18#undef TCL_STORAGE_CLASS 19#define TCL_STORAGE_CLASS DLLEXPORT 20 21/* 22 * The default prompt used when the user has not overridden it. 23 */ 24 25#define DEFAULT_PRIMARY_PROMPT "% " 26 27/* 28 * Declarations for various library functions and variables (don't want to 29 * include tclPort.h here, because people might copy this file out of the Tcl 30 * source directory to make their own modified versions). 31 */ 32 33extern CRTIMPORT int isatty(int fd); 34 35static Tcl_Obj *tclStartupScriptPath = NULL; 36static Tcl_Obj *tclStartupScriptEncoding = NULL; 37static Tcl_MainLoopProc *mainLoopProc = NULL; 38 39/* 40 * Structure definition for information used to keep the state of an 41 * interactive command processor that reads lines from standard input and 42 * writes prompts and results to standard output. 43 */ 44 45typedef enum { 46 PROMPT_NONE, /* Print no prompt */ 47 PROMPT_START, /* Print prompt for command start */ 48 PROMPT_CONTINUE /* Print prompt for command continuation */ 49} PromptType; 50 51typedef struct InteractiveState { 52 Tcl_Channel input; /* The standard input channel from which lines 53 * are read. */ 54 int tty; /* Non-zero means standard input is a 55 * terminal-like device. Zero means it's a 56 * file. */ 57 Tcl_Obj *commandPtr; /* Used to assemble lines of input into Tcl 58 * commands. */ 59 PromptType prompt; /* Next prompt to print */ 60 Tcl_Interp *interp; /* Interpreter that evaluates interactive 61 * commands. */ 62} InteractiveState; 63 64/* 65 * Forward declarations for functions defined later in this file. 66 */ 67 68static void Prompt(Tcl_Interp *interp, PromptType *promptPtr); 69static void StdinProc(ClientData clientData, int mask); 70 71/* 72 *---------------------------------------------------------------------- 73 * 74 * Tcl_SetStartupScript -- 75 * 76 * Sets the path and encoding of the startup script to be evaluated by 77 * Tcl_Main, used to override the command line processing. 78 * 79 * Results: 80 * None. 81 * 82 * Side effects: 83 * 84 *---------------------------------------------------------------------- 85 */ 86 87void 88Tcl_SetStartupScript( 89 Tcl_Obj *path, /* Filesystem path of startup script file */ 90 CONST char *encoding) /* Encoding of the data in that file */ 91{ 92 Tcl_Obj *newEncoding = NULL; 93 if (encoding != NULL) { 94 newEncoding = Tcl_NewStringObj(encoding, -1); 95 } 96 97 if (tclStartupScriptPath != NULL) { 98 Tcl_DecrRefCount(tclStartupScriptPath); 99 } 100 tclStartupScriptPath = path; 101 if (tclStartupScriptPath != NULL) { 102 Tcl_IncrRefCount(tclStartupScriptPath); 103 } 104 105 if (tclStartupScriptEncoding != NULL) { 106 Tcl_DecrRefCount(tclStartupScriptEncoding); 107 } 108 tclStartupScriptEncoding = newEncoding; 109 if (tclStartupScriptEncoding != NULL) { 110 Tcl_IncrRefCount(tclStartupScriptEncoding); 111 } 112} 113 114/* 115 *---------------------------------------------------------------------- 116 * 117 * Tcl_GetStartupScript -- 118 * 119 * Gets the path and encoding of the startup script to be evaluated by 120 * Tcl_Main. 121 * 122 * Results: 123 * The path of the startup script; NULL if none has been set. 124 * 125 * Side effects: 126 * If encodingPtr is not NULL, stores a (CONST char *) in it pointing to 127 * the encoding name registered for the startup script. Tcl retains 128 * ownership of the string, and may free it. Caller should make a copy 129 * for long-term use. 130 * 131 *---------------------------------------------------------------------- 132 */ 133 134Tcl_Obj * 135Tcl_GetStartupScript( 136 CONST char **encodingPtr) /* When not NULL, points to storage for the 137 * (CONST char *) that points to the 138 * registered encoding name for the startup 139 * script */ 140{ 141 if (encodingPtr != NULL) { 142 if (tclStartupScriptEncoding == NULL) { 143 *encodingPtr = NULL; 144 } else { 145 *encodingPtr = Tcl_GetString(tclStartupScriptEncoding); 146 } 147 } 148 return tclStartupScriptPath; 149} 150 151/* 152 *---------------------------------------------------------------------- 153 * 154 * TclSetStartupScriptPath -- 155 * 156 * Primes the startup script VFS path, used to override the command line 157 * processing. 158 * 159 * Results: 160 * None. 161 * 162 * Side effects: 163 * This function initializes the VFS path of the Tcl script to run at 164 * startup. 165 * 166 *---------------------------------------------------------------------- 167 */ 168 169void 170TclSetStartupScriptPath( 171 Tcl_Obj *path) 172{ 173 Tcl_SetStartupScript(path, NULL); 174} 175 176/* 177 *---------------------------------------------------------------------- 178 * 179 * TclGetStartupScriptPath -- 180 * 181 * Gets the startup script VFS path, used to override the command line 182 * processing. 183 * 184 * Results: 185 * The startup script VFS path, NULL if none has been set. 186 * 187 * Side effects: 188 * None. 189 * 190 *---------------------------------------------------------------------- 191 */ 192 193Tcl_Obj * 194TclGetStartupScriptPath(void) 195{ 196 return Tcl_GetStartupScript(NULL); 197} 198 199/* 200 *---------------------------------------------------------------------- 201 * 202 * TclSetStartupScriptFileName -- 203 * 204 * Primes the startup script file name, used to override the command line 205 * processing. 206 * 207 * Results: 208 * None. 209 * 210 * Side effects: 211 * This function initializes the file name of the Tcl script to run at 212 * startup. 213 * 214 *---------------------------------------------------------------------- 215 */ 216 217void 218TclSetStartupScriptFileName( 219 CONST char *fileName) 220{ 221 Tcl_Obj *path = Tcl_NewStringObj(fileName,-1); 222 Tcl_SetStartupScript(path, NULL); 223} 224 225/* 226 *---------------------------------------------------------------------- 227 * 228 * TclGetStartupScriptFileName -- 229 * 230 * Gets the startup script file name, used to override the command line 231 * processing. 232 * 233 * Results: 234 * The startup script file name, NULL if none has been set. 235 * 236 * Side effects: 237 * None. 238 * 239 *---------------------------------------------------------------------- 240 */ 241 242CONST char * 243TclGetStartupScriptFileName(void) 244{ 245 Tcl_Obj *path = Tcl_GetStartupScript(NULL); 246 247 if (path == NULL) { 248 return NULL; 249 } 250 return Tcl_GetString(path); 251} 252 253/*---------------------------------------------------------------------- 254 * 255 * Tcl_SourceRCFile -- 256 * 257 * This function is typically invoked by Tcl_Main of Tk_Main function to 258 * source an application specific rc file into the interpreter at startup 259 * time. 260 * 261 * Results: 262 * None. 263 * 264 * Side effects: 265 * Depends on what's in the rc script. 266 * 267 *---------------------------------------------------------------------- 268 */ 269 270void 271Tcl_SourceRCFile( 272 Tcl_Interp *interp) /* Interpreter to source rc file into. */ 273{ 274 Tcl_DString temp; 275 CONST char *fileName; 276 Tcl_Channel errChannel; 277 278 fileName = Tcl_GetVar(interp, "tcl_rcFileName", TCL_GLOBAL_ONLY); 279 if (fileName != NULL) { 280 Tcl_Channel c; 281 CONST char *fullName; 282 283 Tcl_DStringInit(&temp); 284 fullName = Tcl_TranslateFileName(interp, fileName, &temp); 285 if (fullName == NULL) { 286 /* 287 * Couldn't translate the file name (e.g. it referred to a bogus 288 * user or there was no HOME environment variable). Just do 289 * nothing. 290 */ 291 } else { 292 /* 293 * Test for the existence of the rc file before trying to read it. 294 */ 295 296 c = Tcl_OpenFileChannel(NULL, fullName, "r", 0); 297 if (c != (Tcl_Channel) NULL) { 298 Tcl_Close(NULL, c); 299 if (Tcl_EvalFile(interp, fullName) != TCL_OK) { 300 errChannel = Tcl_GetStdChannel(TCL_STDERR); 301 if (errChannel) { 302 Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp)); 303 Tcl_WriteChars(errChannel, "\n", 1); 304 } 305 } 306 } 307 } 308 Tcl_DStringFree(&temp); 309 } 310} 311 312/*---------------------------------------------------------------------- 313 * 314 * Tcl_Main -- 315 * 316 * Main program for tclsh and most other Tcl-based applications. 317 * 318 * Results: 319 * None. This function never returns (it exits the process when it's 320 * done). 321 * 322 * Side effects: 323 * This function initializes the Tcl world and then starts interpreting 324 * commands; almost anything could happen, depending on the script being 325 * interpreted. 326 * 327 *---------------------------------------------------------------------- 328 */ 329 330void 331Tcl_Main( 332 int argc, /* Number of arguments. */ 333 char **argv, /* Array of argument strings. */ 334 Tcl_AppInitProc *appInitProc) 335 /* Application-specific initialization 336 * function to call after most initialization 337 * but before starting to execute commands. */ 338{ 339 Tcl_Obj *path, *resultPtr, *argvPtr, *commandPtr = NULL; 340 CONST char *encodingName = NULL; 341 PromptType prompt = PROMPT_START; 342 int code, length, tty, exitCode = 0; 343 Tcl_Channel inChannel, outChannel, errChannel; 344 Tcl_Interp *interp; 345 Tcl_DString appName; 346 347 Tcl_FindExecutable(argv[0]); 348 349 interp = Tcl_CreateInterp(); 350 Tcl_InitMemory(interp); 351 352 /* 353 * If the application has not already set a startup script, parse the 354 * first few command line arguments to determine the script path and 355 * encoding. 356 */ 357 358 if (NULL == Tcl_GetStartupScript(NULL)) { 359 360 /* 361 * Check whether first 3 args (argv[1] - argv[3]) look like 362 * -encoding ENCODING FILENAME 363 * or like 364 * FILENAME 365 */ 366 367 if ((argc > 3) && (0 == strcmp("-encoding", argv[1])) 368 && ('-' != argv[3][0])) { 369 Tcl_SetStartupScript(Tcl_NewStringObj(argv[3], -1), argv[2]); 370 argc -= 3; 371 argv += 3; 372 } else if ((argc > 1) && ('-' != argv[1][0])) { 373 Tcl_SetStartupScript(Tcl_NewStringObj(argv[1], -1), NULL); 374 argc--; 375 argv++; 376 } 377 } 378 379 path = Tcl_GetStartupScript(&encodingName); 380 if (path == NULL) { 381 Tcl_ExternalToUtfDString(NULL, argv[0], -1, &appName); 382 } else { 383 CONST char *pathName = Tcl_GetStringFromObj(path, &length); 384 Tcl_ExternalToUtfDString(NULL, pathName, length, &appName); 385 path = Tcl_NewStringObj(Tcl_DStringValue(&appName), -1); 386 Tcl_SetStartupScript(path, encodingName); 387 } 388 Tcl_SetVar(interp, "argv0", Tcl_DStringValue(&appName), TCL_GLOBAL_ONLY); 389 Tcl_DStringFree(&appName); 390 argc--; 391 argv++; 392 393 Tcl_SetVar2Ex(interp, "argc", NULL, Tcl_NewIntObj(argc), TCL_GLOBAL_ONLY); 394 395 argvPtr = Tcl_NewListObj(0, NULL); 396 while (argc--) { 397 Tcl_DString ds; 398 Tcl_ExternalToUtfDString(NULL, *argv++, -1, &ds); 399 Tcl_ListObjAppendElement(NULL, argvPtr, Tcl_NewStringObj( 400 Tcl_DStringValue(&ds), Tcl_DStringLength(&ds))); 401 Tcl_DStringFree(&ds); 402 } 403 Tcl_SetVar2Ex(interp, "argv", NULL, argvPtr, TCL_GLOBAL_ONLY); 404 405 /* 406 * Set the "tcl_interactive" variable. 407 */ 408 409 tty = isatty(0); 410 Tcl_SetVar(interp, "tcl_interactive", ((path == NULL) && tty) ? "1" : "0", 411 TCL_GLOBAL_ONLY); 412 413 /* 414 * Invoke application-specific initialization. 415 */ 416 417 Tcl_Preserve((ClientData) interp); 418 if ((*appInitProc)(interp) != TCL_OK) { 419 errChannel = Tcl_GetStdChannel(TCL_STDERR); 420 if (errChannel) { 421 Tcl_WriteChars(errChannel, 422 "application-specific initialization failed: ", -1); 423 Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp)); 424 Tcl_WriteChars(errChannel, "\n", 1); 425 } 426 } 427 if (Tcl_InterpDeleted(interp)) { 428 goto done; 429 } 430 if (Tcl_LimitExceeded(interp)) { 431 goto done; 432 } 433 434 /* 435 * If a script file was specified then just source that file and quit. 436 * Must fetch it again, as the appInitProc might have reset it. 437 */ 438 439 path = Tcl_GetStartupScript(&encodingName); 440 if (path != NULL) { 441 code = Tcl_FSEvalFileEx(interp, path, encodingName); 442 if (code != TCL_OK) { 443 errChannel = Tcl_GetStdChannel(TCL_STDERR); 444 if (errChannel) { 445 Tcl_Obj *options = Tcl_GetReturnOptions(interp, code); 446 Tcl_Obj *keyPtr, *valuePtr; 447 448 TclNewLiteralStringObj(keyPtr, "-errorinfo"); 449 Tcl_IncrRefCount(keyPtr); 450 Tcl_DictObjGet(NULL, options, keyPtr, &valuePtr); 451 Tcl_DecrRefCount(keyPtr); 452 453 if (valuePtr) { 454 Tcl_WriteObj(errChannel, valuePtr); 455 } 456 Tcl_WriteChars(errChannel, "\n", 1); 457 } 458 exitCode = 1; 459 } 460 goto done; 461 } 462 463 /* 464 * We're running interactively. Source a user-specific startup file if the 465 * application specified one and if the file exists. 466 */ 467 468 Tcl_SourceRCFile(interp); 469 if (Tcl_LimitExceeded(interp)) { 470 goto done; 471 } 472 473 /* 474 * Process commands from stdin until there's an end-of-file. Note that we 475 * need to fetch the standard channels again after every eval, since they 476 * may have been changed. 477 */ 478 479 commandPtr = Tcl_NewObj(); 480 Tcl_IncrRefCount(commandPtr); 481 482 /* 483 * Get a new value for tty if anyone writes to ::tcl_interactive 484 */ 485 486 Tcl_LinkVar(interp, "tcl_interactive", (char *) &tty, TCL_LINK_BOOLEAN); 487 inChannel = Tcl_GetStdChannel(TCL_STDIN); 488 outChannel = Tcl_GetStdChannel(TCL_STDOUT); 489 while ((inChannel != (Tcl_Channel) NULL) && !Tcl_InterpDeleted(interp)) { 490 if (mainLoopProc == NULL) { 491 if (tty) { 492 Prompt(interp, &prompt); 493 if (Tcl_InterpDeleted(interp)) { 494 break; 495 } 496 if (Tcl_LimitExceeded(interp)) { 497 break; 498 } 499 inChannel = Tcl_GetStdChannel(TCL_STDIN); 500 if (inChannel == (Tcl_Channel) NULL) { 501 break; 502 } 503 } 504 if (Tcl_IsShared(commandPtr)) { 505 Tcl_DecrRefCount(commandPtr); 506 commandPtr = Tcl_DuplicateObj(commandPtr); 507 Tcl_IncrRefCount(commandPtr); 508 } 509 length = Tcl_GetsObj(inChannel, commandPtr); 510 if (length < 0) { 511 if (Tcl_InputBlocked(inChannel)) { 512 /* 513 * This can only happen if stdin has been set to 514 * non-blocking. In that case cycle back and try again. 515 * This sets up a tight polling loop (since we have no 516 * event loop running). If this causes bad CPU hogging, 517 * we might try toggling the blocking on stdin instead. 518 */ 519 520 continue; 521 } 522 523 /* 524 * Either EOF, or an error on stdin; we're done 525 */ 526 527 break; 528 } 529 530 /* 531 * Add the newline removed by Tcl_GetsObj back to the string. 532 * Have to add it back before testing completeness, because 533 * it can make a difference. [Bug 1775878]. 534 */ 535 536 if (Tcl_IsShared(commandPtr)) { 537 Tcl_DecrRefCount(commandPtr); 538 commandPtr = Tcl_DuplicateObj(commandPtr); 539 Tcl_IncrRefCount(commandPtr); 540 } 541 Tcl_AppendToObj(commandPtr, "\n", 1); 542 if (!TclObjCommandComplete(commandPtr)) { 543 prompt = PROMPT_CONTINUE; 544 continue; 545 } 546 547 prompt = PROMPT_START; 548 /* 549 * The final newline is syntactically redundant, and causes 550 * some error messages troubles deeper in, so lop it back off. 551 */ 552 Tcl_GetStringFromObj(commandPtr, &length); 553 Tcl_SetObjLength(commandPtr, --length); 554 code = Tcl_RecordAndEvalObj(interp, commandPtr, TCL_EVAL_GLOBAL); 555 inChannel = Tcl_GetStdChannel(TCL_STDIN); 556 outChannel = Tcl_GetStdChannel(TCL_STDOUT); 557 errChannel = Tcl_GetStdChannel(TCL_STDERR); 558 Tcl_DecrRefCount(commandPtr); 559 commandPtr = Tcl_NewObj(); 560 Tcl_IncrRefCount(commandPtr); 561 if (code != TCL_OK) { 562 if (errChannel) { 563 Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp)); 564 Tcl_WriteChars(errChannel, "\n", 1); 565 } 566 } else if (tty) { 567 resultPtr = Tcl_GetObjResult(interp); 568 Tcl_IncrRefCount(resultPtr); 569 Tcl_GetStringFromObj(resultPtr, &length); 570 if ((length > 0) && outChannel) { 571 Tcl_WriteObj(outChannel, resultPtr); 572 Tcl_WriteChars(outChannel, "\n", 1); 573 } 574 Tcl_DecrRefCount(resultPtr); 575 } 576 } else { /* (mainLoopProc != NULL) */ 577 /* 578 * If a main loop has been defined while running interactively, we 579 * want to start a fileevent based prompt by establishing a 580 * channel handler for stdin. 581 */ 582 583 InteractiveState *isPtr = NULL; 584 585 if (inChannel) { 586 if (tty) { 587 Prompt(interp, &prompt); 588 } 589 isPtr = (InteractiveState *) 590 ckalloc((int) sizeof(InteractiveState)); 591 isPtr->input = inChannel; 592 isPtr->tty = tty; 593 isPtr->commandPtr = commandPtr; 594 isPtr->prompt = prompt; 595 isPtr->interp = interp; 596 597 Tcl_UnlinkVar(interp, "tcl_interactive"); 598 Tcl_LinkVar(interp, "tcl_interactive", (char *) &(isPtr->tty), 599 TCL_LINK_BOOLEAN); 600 601 Tcl_CreateChannelHandler(inChannel, TCL_READABLE, StdinProc, 602 (ClientData) isPtr); 603 } 604 605 (*mainLoopProc)(); 606 mainLoopProc = NULL; 607 608 if (inChannel) { 609 tty = isPtr->tty; 610 Tcl_UnlinkVar(interp, "tcl_interactive"); 611 Tcl_LinkVar(interp, "tcl_interactive", (char *) &tty, 612 TCL_LINK_BOOLEAN); 613 prompt = isPtr->prompt; 614 commandPtr = isPtr->commandPtr; 615 if (isPtr->input != (Tcl_Channel) NULL) { 616 Tcl_DeleteChannelHandler(isPtr->input, StdinProc, 617 (ClientData) isPtr); 618 } 619 ckfree((char *)isPtr); 620 } 621 inChannel = Tcl_GetStdChannel(TCL_STDIN); 622 outChannel = Tcl_GetStdChannel(TCL_STDOUT); 623 errChannel = Tcl_GetStdChannel(TCL_STDERR); 624 } 625#ifdef TCL_MEM_DEBUG 626 627 /* 628 * This code here only for the (unsupported and deprecated) [checkmem] 629 * command. 630 */ 631 632 if (tclMemDumpFileName != NULL) { 633 mainLoopProc = NULL; 634 Tcl_DeleteInterp(interp); 635 } 636#endif 637 } 638 639 done: 640 if ((exitCode == 0) && (mainLoopProc != NULL) 641 && !Tcl_LimitExceeded(interp)) { 642 /* 643 * If everything has gone OK so far, call the main loop proc, if it 644 * exists. Packages (like Tk) can set it to start processing events at 645 * this point. 646 */ 647 648 (*mainLoopProc)(); 649 mainLoopProc = NULL; 650 } 651 if (commandPtr != NULL) { 652 Tcl_DecrRefCount(commandPtr); 653 } 654 655 /* 656 * Rather than calling exit, invoke the "exit" command so that users can 657 * replace "exit" with some other command to do additional cleanup on 658 * exit. The Tcl_EvalObjEx call should never return. 659 */ 660 661 if (!Tcl_InterpDeleted(interp)) { 662 if (!Tcl_LimitExceeded(interp)) { 663 Tcl_Obj *cmd = Tcl_ObjPrintf("exit %d", exitCode); 664 Tcl_IncrRefCount(cmd); 665 Tcl_EvalObjEx(interp, cmd, TCL_EVAL_GLOBAL); 666 Tcl_DecrRefCount(cmd); 667 } 668 669 /* 670 * If Tcl_EvalObjEx returns, trying to eval [exit], something unusual 671 * is happening. Maybe interp has been deleted; maybe [exit] was 672 * redefined, maybe we've blown up because of an exceeded limit. We 673 * still want to cleanup and exit. 674 */ 675 676 if (!Tcl_InterpDeleted(interp)) { 677 Tcl_DeleteInterp(interp); 678 } 679 } 680 Tcl_SetStartupScript(NULL, NULL); 681 682 /* 683 * If we get here, the master interp has been deleted. Allow its 684 * destruction with the last matching Tcl_Release. 685 */ 686 687 Tcl_Release((ClientData) interp); 688 Tcl_Exit(exitCode); 689} 690 691/* 692 *--------------------------------------------------------------- 693 * 694 * Tcl_SetMainLoop -- 695 * 696 * Sets an alternative main loop function. 697 * 698 * Results: 699 * Returns the previously defined main loop function. 700 * 701 * Side effects: 702 * This function will be called before Tcl exits, allowing for the 703 * creation of an event loop. 704 * 705 *--------------------------------------------------------------- 706 */ 707 708void 709Tcl_SetMainLoop( 710 Tcl_MainLoopProc *proc) 711{ 712 mainLoopProc = proc; 713} 714 715/* 716 *---------------------------------------------------------------------- 717 * 718 * StdinProc -- 719 * 720 * This function is invoked by the event dispatcher whenever standard 721 * input becomes readable. It grabs the next line of input characters, 722 * adds them to a command being assembled, and executes the command if 723 * it's complete. 724 * 725 * Results: 726 * None. 727 * 728 * Side effects: 729 * Could be almost arbitrary, depending on the command that's typed. 730 * 731 *---------------------------------------------------------------------- 732 */ 733 734 /* ARGSUSED */ 735static void 736StdinProc( 737 ClientData clientData, /* The state of interactive cmd line */ 738 int mask) /* Not used. */ 739{ 740 InteractiveState *isPtr = (InteractiveState *) clientData; 741 Tcl_Channel chan = isPtr->input; 742 Tcl_Obj *commandPtr = isPtr->commandPtr; 743 Tcl_Interp *interp = isPtr->interp; 744 int code, length; 745 746 if (Tcl_IsShared(commandPtr)) { 747 Tcl_DecrRefCount(commandPtr); 748 commandPtr = Tcl_DuplicateObj(commandPtr); 749 Tcl_IncrRefCount(commandPtr); 750 } 751 length = Tcl_GetsObj(chan, commandPtr); 752 if (length < 0) { 753 if (Tcl_InputBlocked(chan)) { 754 return; 755 } 756 if (isPtr->tty) { 757 /* 758 * Would be better to find a way to exit the mainLoop? Or perhaps 759 * evaluate [exit]? Leaving as is for now due to compatibility 760 * concerns. 761 */ 762 763 Tcl_Exit(0); 764 } 765 Tcl_DeleteChannelHandler(chan, StdinProc, (ClientData) isPtr); 766 return; 767 } 768 769 if (Tcl_IsShared(commandPtr)) { 770 Tcl_DecrRefCount(commandPtr); 771 commandPtr = Tcl_DuplicateObj(commandPtr); 772 Tcl_IncrRefCount(commandPtr); 773 } 774 Tcl_AppendToObj(commandPtr, "\n", 1); 775 if (!TclObjCommandComplete(commandPtr)) { 776 isPtr->prompt = PROMPT_CONTINUE; 777 goto prompt; 778 } 779 isPtr->prompt = PROMPT_START; 780 Tcl_GetStringFromObj(commandPtr, &length); 781 Tcl_SetObjLength(commandPtr, --length); 782 783 /* 784 * Disable the stdin channel handler while evaluating the command; 785 * otherwise if the command re-enters the event loop we might process 786 * commands from stdin before the current command is finished. Among other 787 * things, this will trash the text of the command being evaluated. 788 */ 789 790 Tcl_CreateChannelHandler(chan, 0, StdinProc, (ClientData) isPtr); 791 code = Tcl_RecordAndEvalObj(interp, commandPtr, TCL_EVAL_GLOBAL); 792 isPtr->input = chan = Tcl_GetStdChannel(TCL_STDIN); 793 Tcl_DecrRefCount(commandPtr); 794 isPtr->commandPtr = commandPtr = Tcl_NewObj(); 795 Tcl_IncrRefCount(commandPtr); 796 if (chan != (Tcl_Channel) NULL) { 797 Tcl_CreateChannelHandler(chan, TCL_READABLE, StdinProc, 798 (ClientData) isPtr); 799 } 800 if (code != TCL_OK) { 801 Tcl_Channel errChannel = Tcl_GetStdChannel(TCL_STDERR); 802 if (errChannel != (Tcl_Channel) NULL) { 803 Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp)); 804 Tcl_WriteChars(errChannel, "\n", 1); 805 } 806 } else if (isPtr->tty) { 807 Tcl_Obj *resultPtr = Tcl_GetObjResult(interp); 808 Tcl_Channel outChannel = Tcl_GetStdChannel(TCL_STDOUT); 809 Tcl_IncrRefCount(resultPtr); 810 Tcl_GetStringFromObj(resultPtr, &length); 811 if ((length >0) && (outChannel != (Tcl_Channel) NULL)) { 812 Tcl_WriteObj(outChannel, resultPtr); 813 Tcl_WriteChars(outChannel, "\n", 1); 814 } 815 Tcl_DecrRefCount(resultPtr); 816 } 817 818 /* 819 * If a tty stdin is still around, output a prompt. 820 */ 821 822 prompt: 823 if (isPtr->tty && (isPtr->input != (Tcl_Channel) NULL)) { 824 Prompt(interp, &(isPtr->prompt)); 825 isPtr->input = Tcl_GetStdChannel(TCL_STDIN); 826 } 827} 828 829/* 830 *---------------------------------------------------------------------- 831 * 832 * Prompt -- 833 * 834 * Issue a prompt on standard output, or invoke a script to issue the 835 * prompt. 836 * 837 * Results: 838 * None. 839 * 840 * Side effects: 841 * A prompt gets output, and a Tcl script may be evaluated in interp. 842 * 843 *---------------------------------------------------------------------- 844 */ 845 846static void 847Prompt( 848 Tcl_Interp *interp, /* Interpreter to use for prompting. */ 849 PromptType *promptPtr) /* Points to type of prompt to print. Filled 850 * with PROMPT_NONE after a prompt is 851 * printed. */ 852{ 853 Tcl_Obj *promptCmdPtr; 854 int code; 855 Tcl_Channel outChannel, errChannel; 856 857 if (*promptPtr == PROMPT_NONE) { 858 return; 859 } 860 861 promptCmdPtr = Tcl_GetVar2Ex(interp, 862 ((*promptPtr == PROMPT_CONTINUE) ? "tcl_prompt2" : "tcl_prompt1"), 863 NULL, TCL_GLOBAL_ONLY); 864 865 if (Tcl_InterpDeleted(interp)) { 866 return; 867 } 868 if (promptCmdPtr == NULL) { 869 defaultPrompt: 870 outChannel = Tcl_GetStdChannel(TCL_STDOUT); 871 if ((*promptPtr == PROMPT_START) 872 && (outChannel != (Tcl_Channel) NULL)) { 873 Tcl_WriteChars(outChannel, DEFAULT_PRIMARY_PROMPT, 874 strlen(DEFAULT_PRIMARY_PROMPT)); 875 } 876 } else { 877 code = Tcl_EvalObjEx(interp, promptCmdPtr, TCL_EVAL_GLOBAL); 878 if (code != TCL_OK) { 879 Tcl_AddErrorInfo(interp, 880 "\n (script that generates prompt)"); 881 errChannel = Tcl_GetStdChannel(TCL_STDERR); 882 if (errChannel != (Tcl_Channel) NULL) { 883 Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp)); 884 Tcl_WriteChars(errChannel, "\n", 1); 885 } 886 goto defaultPrompt; 887 } 888 } 889 890 outChannel = Tcl_GetStdChannel(TCL_STDOUT); 891 if (outChannel != (Tcl_Channel) NULL) { 892 Tcl_Flush(outChannel); 893 } 894 *promptPtr = PROMPT_NONE; 895} 896 897/* 898 * Local Variables: 899 * mode: c 900 * c-basic-offset: 4 901 * fill-column: 78 902 * End: 903 */ 904