diff options
Diffstat (limited to 'generic/tclMain.c')
| -rw-r--r-- | generic/tclMain.c | 578 |
1 files changed, 199 insertions, 379 deletions
diff --git a/generic/tclMain.c b/generic/tclMain.c index 7a19a38..28a3dab 100644 --- a/generic/tclMain.c +++ b/generic/tclMain.c @@ -1,4 +1,4 @@ -/* +/* * tclMain.c -- * * Main program for Tcl shells and other Tcl-based applications. @@ -7,177 +7,100 @@ * Copyright (c) 1994-1997 Sun Microsystems, Inc. * Copyright (c) 2000 Ajuba Solutions. * - * See the file "license.terms" for information on usage and redistribution of - * this file, and for a DISCLAIMER OF ALL WARRANTIES. + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. */ +#include "tcl.h" #include "tclInt.h" -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLEXPORT - -/* - * The default prompt used when the user has not overridden it. - */ - -#define DEFAULT_PRIMARY_PROMPT "% " +# undef TCL_STORAGE_CLASS +# define TCL_STORAGE_CLASS DLLEXPORT /* - * Declarations for various library functions and variables (don't want to - * include tclPort.h here, because people might copy this file out of the Tcl - * source directory to make their own modified versions). + * Declarations for various library procedures and variables (don't want + * to include tclPort.h here, because people might copy this file out of + * the Tcl source directory to make their own modified versions). */ -extern CRTIMPORT int isatty(int fd); +extern int isatty _ANSI_ARGS_((int fd)); static Tcl_Obj *tclStartupScriptPath = NULL; -static Tcl_Obj *tclStartupScriptEncoding = NULL; + static Tcl_MainLoopProc *mainLoopProc = NULL; -/* - * Structure definition for information used to keep the state of an - * interactive command processor that reads lines from standard input and - * writes prompts and results to standard output. +/* + * Structure definition for information used to keep the state of + * an interactive command processor that reads lines from standard + * input and writes prompts and results to standard output. */ typedef enum { - PROMPT_NONE, /* Print no prompt */ - PROMPT_START, /* Print prompt for command start */ - PROMPT_CONTINUE /* Print prompt for command continuation */ + PROMPT_NONE, /* Print no prompt */ + PROMPT_START, /* Print prompt for command start */ + PROMPT_CONTINUE /* Print prompt for command continuation */ } PromptType; typedef struct InteractiveState { - Tcl_Channel input; /* The standard input channel from which lines - * are read. */ - int tty; /* Non-zero means standard input is a - * terminal-like device. Zero means it's a - * file. */ - Tcl_Obj *commandPtr; /* Used to assemble lines of input into Tcl - * commands. */ + Tcl_Channel input; /* The standard input channel from which + * lines are read. */ + int tty; /* Non-zero means standard input is a + * terminal-like device. Zero means it's + * a file. */ + Tcl_Obj *commandPtr; /* Used to assemble lines of input into + * Tcl commands. */ PromptType prompt; /* Next prompt to print */ Tcl_Interp *interp; /* Interpreter that evaluates interactive * commands. */ } InteractiveState; /* - * Forward declarations for functions defined later in this file. + * Forward declarations for procedures defined later in this file. */ -static void Prompt(Tcl_Interp *interp, PromptType *promptPtr); -static void StdinProc(ClientData clientData, int mask); +static void Prompt _ANSI_ARGS_((Tcl_Interp *interp, + PromptType *promptPtr)); +static void StdinProc _ANSI_ARGS_((ClientData clientData, + int mask)); + /* *---------------------------------------------------------------------- * - * Tcl_SetStartupScript -- + * TclSetStartupScriptPath -- * - * Sets the path and encoding of the startup script to be evaluated by - * Tcl_Main, used to override the command line processing. + * Primes the startup script VFS path, used to override the + * command line processing. * * Results: - * None. + * None. * * Side effects: + * This procedure initializes the VFS path of the Tcl script to + * run at startup. * *---------------------------------------------------------------------- */ - -void -Tcl_SetStartupScript( - Tcl_Obj *path, /* Filesystem path of startup script file */ - CONST char *encoding) /* Encoding of the data in that file */ +void TclSetStartupScriptPath(pathPtr) + Tcl_Obj *pathPtr; { - Tcl_Obj *newEncoding = NULL; - if (encoding != NULL) { - newEncoding = Tcl_NewStringObj(encoding, -1); - } - if (tclStartupScriptPath != NULL) { Tcl_DecrRefCount(tclStartupScriptPath); } - tclStartupScriptPath = path; + tclStartupScriptPath = pathPtr; if (tclStartupScriptPath != NULL) { Tcl_IncrRefCount(tclStartupScriptPath); } - - if (tclStartupScriptEncoding != NULL) { - Tcl_DecrRefCount(tclStartupScriptEncoding); - } - tclStartupScriptEncoding = newEncoding; - if (tclStartupScriptEncoding != NULL) { - Tcl_IncrRefCount(tclStartupScriptEncoding); - } } - -/* - *---------------------------------------------------------------------- - * - * Tcl_GetStartupScript -- - * - * Gets the path and encoding of the startup script to be evaluated by - * Tcl_Main. - * - * Results: - * The path of the startup script; NULL if none has been set. - * - * Side effects: - * If encodingPtr is not NULL, stores a (CONST char *) in it pointing to - * the encoding name registered for the startup script. Tcl retains - * ownership of the string, and may free it. Caller should make a copy - * for long-term use. - * - *---------------------------------------------------------------------- - */ -Tcl_Obj * -Tcl_GetStartupScript( - CONST char **encodingPtr) /* When not NULL, points to storage for the - * (CONST char *) that points to the - * registered encoding name for the startup - * script */ -{ - if (encodingPtr != NULL) { - if (tclStartupScriptEncoding == NULL) { - *encodingPtr = NULL; - } else { - *encodingPtr = Tcl_GetString(tclStartupScriptEncoding); - } - } - return tclStartupScriptPath; -} - -/* - *---------------------------------------------------------------------- - * - * TclSetStartupScriptPath -- - * - * Primes the startup script VFS path, used to override the command line - * processing. - * - * Results: - * None. - * - * Side effects: - * This function initializes the VFS path of the Tcl script to run at - * startup. - * - *---------------------------------------------------------------------- - */ -void -TclSetStartupScriptPath( - Tcl_Obj *path) -{ - Tcl_SetStartupScript(path, NULL); -} - /* *---------------------------------------------------------------------- * * TclGetStartupScriptPath -- * - * Gets the startup script VFS path, used to override the command line - * processing. + * Gets the startup script VFS path, used to override the + * command line processing. * * Results: * The startup script VFS path, NULL if none has been set. @@ -187,46 +110,44 @@ TclSetStartupScriptPath( * *---------------------------------------------------------------------- */ - -Tcl_Obj * -TclGetStartupScriptPath(void) +Tcl_Obj *TclGetStartupScriptPath() { - return Tcl_GetStartupScript(NULL); + return tclStartupScriptPath; } - + + /* *---------------------------------------------------------------------- * * TclSetStartupScriptFileName -- * - * Primes the startup script file name, used to override the command line - * processing. + * Primes the startup script file name, used to override the + * command line processing. * * Results: - * None. + * None. * * Side effects: - * This function initializes the file name of the Tcl script to run at - * startup. + * This procedure initializes the file name of the Tcl script to + * run at startup. * *---------------------------------------------------------------------- */ - -void -TclSetStartupScriptFileName( - CONST char *fileName) +void TclSetStartupScriptFileName(fileName) + CONST char *fileName; { - Tcl_Obj *path = Tcl_NewStringObj(fileName,-1); - Tcl_SetStartupScript(path, NULL); + Tcl_Obj *pathPtr = Tcl_NewStringObj(fileName,-1); + TclSetStartupScriptPath(pathPtr); } + /* *---------------------------------------------------------------------- * * TclGetStartupScriptFileName -- * - * Gets the startup script file name, used to override the command line - * processing. + * Gets the startup script file name, used to override the + * command line processing. * * Results: * The startup script file name, NULL if none has been set. @@ -236,111 +157,54 @@ TclSetStartupScriptFileName( * *---------------------------------------------------------------------- */ - -CONST char * -TclGetStartupScriptFileName(void) +CONST char *TclGetStartupScriptFileName() { - Tcl_Obj *path = Tcl_GetStartupScript(NULL); + Tcl_Obj *pathPtr = TclGetStartupScriptPath(); - if (path == NULL) { + if (pathPtr == NULL) { return NULL; } - return Tcl_GetString(path); + return Tcl_GetString(pathPtr); } - -/*---------------------------------------------------------------------- - * - * Tcl_SourceRCFile -- - * - * This function is typically invoked by Tcl_Main of Tk_Main function to - * source an application specific rc file into the interpreter at startup - * time. - * - * Results: - * None. - * - * Side effects: - * Depends on what's in the rc script. - * - *---------------------------------------------------------------------- - */ - -void -Tcl_SourceRCFile( - Tcl_Interp *interp) /* Interpreter to source rc file into. */ -{ - Tcl_DString temp; - CONST char *fileName; - Tcl_Channel errChannel; - fileName = Tcl_GetVar(interp, "tcl_rcFileName", TCL_GLOBAL_ONLY); - if (fileName != NULL) { - Tcl_Channel c; - CONST char *fullName; - - Tcl_DStringInit(&temp); - fullName = Tcl_TranslateFileName(interp, fileName, &temp); - if (fullName == NULL) { - /* - * Couldn't translate the file name (e.g. it referred to a bogus - * user or there was no HOME environment variable). Just do - * nothing. - */ - } else { - /* - * Test for the existence of the rc file before trying to read it. - */ - c = Tcl_OpenFileChannel(NULL, fullName, "r", 0); - if (c != (Tcl_Channel) NULL) { - Tcl_Close(NULL, c); - if (Tcl_EvalFile(interp, fullName) != TCL_OK) { - errChannel = Tcl_GetStdChannel(TCL_STDERR); - if (errChannel) { - Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp)); - Tcl_WriteChars(errChannel, "\n", 1); - } - } - } - } - Tcl_DStringFree(&temp); - } -} -/*---------------------------------------------------------------------- +/* + *---------------------------------------------------------------------- * * Tcl_Main -- * * Main program for tclsh and most other Tcl-based applications. * * Results: - * None. This function never returns (it exits the process when it's - * done). + * None. This procedure never returns (it exits the process when + * it's done). * * Side effects: - * This function initializes the Tcl world and then starts interpreting - * commands; almost anything could happen, depending on the script being - * interpreted. + * This procedure initializes the Tcl world and then starts + * interpreting commands; almost anything could happen, depending + * on the script being interpreted. * *---------------------------------------------------------------------- */ void -Tcl_Main( - int argc, /* Number of arguments. */ - char **argv, /* Array of argument strings. */ - Tcl_AppInitProc *appInitProc) +Tcl_Main(argc, argv, appInitProc) + int argc; /* Number of arguments. */ + char **argv; /* Array of argument strings. */ + Tcl_AppInitProc *appInitProc; /* Application-specific initialization - * function to call after most initialization - * but before starting to execute commands. */ + * procedure to call after most + * initialization but before starting to + * execute commands. */ { - Tcl_Obj *path, *resultPtr, *argvPtr, *commandPtr = NULL; - CONST char *encodingName = NULL; + Tcl_Obj *resultPtr, *argvPtr, *commandPtr = NULL; PromptType prompt = PROMPT_START; int code, length, tty, exitCode = 0; Tcl_Channel inChannel, outChannel, errChannel; Tcl_Interp *interp; Tcl_DString appName; + Tcl_Obj *objPtr; Tcl_FindExecutable(argv[0]); @@ -348,48 +212,35 @@ Tcl_Main( Tcl_InitMemory(interp); /* - * If the application has not already set a startup script, parse the - * first few command line arguments to determine the script path and - * encoding. + * Make command-line arguments available in the Tcl variables "argc" + * and "argv". If the first argument doesn't start with a "-" then + * strip it off and use it as the name of a script file to process. */ - if (NULL == Tcl_GetStartupScript(NULL)) { - - /* - * Check whether first 3 args (argv[1] - argv[3]) look like - * -encoding ENCODING FILENAME - * or like - * FILENAME - */ - - if ((argc > 3) && (0 == strcmp("-encoding", argv[1])) - && ('-' != argv[3][0])) { - Tcl_SetStartupScript(Tcl_NewStringObj(argv[3], -1), argv[2]); - argc -= 3; - argv += 3; - } else if ((argc > 1) && ('-' != argv[1][0])) { - Tcl_SetStartupScript(Tcl_NewStringObj(argv[1], -1), NULL); + if (TclGetStartupScriptPath() == NULL) { + if ((argc > 1) && (argv[1][0] != '-')) { + TclSetStartupScriptFileName(argv[1]); argc--; argv++; } } - path = Tcl_GetStartupScript(&encodingName); - if (path == NULL) { + if (TclGetStartupScriptPath() == NULL) { Tcl_ExternalToUtfDString(NULL, argv[0], -1, &appName); } else { - CONST char *pathName = Tcl_GetStringFromObj(path, &length); - Tcl_ExternalToUtfDString(NULL, pathName, length, &appName); - path = Tcl_NewStringObj(Tcl_DStringValue(&appName), -1); - Tcl_SetStartupScript(path, encodingName); + TclSetStartupScriptFileName(Tcl_ExternalToUtfDString(NULL, + TclGetStartupScriptFileName(), -1, &appName)); } Tcl_SetVar(interp, "argv0", Tcl_DStringValue(&appName), TCL_GLOBAL_ONLY); Tcl_DStringFree(&appName); argc--; argv++; - Tcl_SetVar2Ex(interp, "argc", NULL, Tcl_NewIntObj(argc), TCL_GLOBAL_ONLY); - + objPtr = Tcl_NewIntObj(argc); + Tcl_IncrRefCount(objPtr); + Tcl_SetVar2Ex(interp, "argc", NULL, objPtr, TCL_GLOBAL_ONLY); + Tcl_DecrRefCount(objPtr); + argvPtr = Tcl_NewListObj(0, NULL); while (argc--) { Tcl_DString ds; @@ -398,16 +249,19 @@ Tcl_Main( Tcl_DStringValue(&ds), Tcl_DStringLength(&ds))); Tcl_DStringFree(&ds); } + Tcl_IncrRefCount(argvPtr); Tcl_SetVar2Ex(interp, "argv", NULL, argvPtr, TCL_GLOBAL_ONLY); + Tcl_DecrRefCount(argvPtr); /* * Set the "tcl_interactive" variable. */ tty = isatty(0); - Tcl_SetVar(interp, "tcl_interactive", ((path == NULL) && tty) ? "1" : "0", + Tcl_SetVar(interp, "tcl_interactive", + ((TclGetStartupScriptPath() == NULL) && tty) ? "1" : "0", TCL_GLOBAL_ONLY); - + /* * Invoke application-specific initialization. */ @@ -425,34 +279,27 @@ Tcl_Main( if (Tcl_InterpDeleted(interp)) { goto done; } - if (Tcl_LimitExceeded(interp)) { - goto done; - } /* - * If a script file was specified then just source that file and quit. - * Must fetch it again, as the appInitProc might have reset it. + * If a script file was specified then just source that file + * and quit. */ - path = Tcl_GetStartupScript(&encodingName); - if (path != NULL) { - code = Tcl_FSEvalFileEx(interp, path, encodingName); + if (TclGetStartupScriptPath() != NULL) { + code = Tcl_FSEvalFile(interp, TclGetStartupScriptPath()); if (code != TCL_OK) { errChannel = Tcl_GetStdChannel(TCL_STDERR); if (errChannel) { - Tcl_Obj *options = Tcl_GetReturnOptions(interp, code); - Tcl_Obj *keyPtr, *valuePtr; - TclNewLiteralStringObj(keyPtr, "-errorinfo"); - Tcl_IncrRefCount(keyPtr); - Tcl_DictObjGet(NULL, options, keyPtr, &valuePtr); - Tcl_DecrRefCount(keyPtr); + /* + * The following statement guarantees that the errorInfo + * variable is set properly. + */ - if (valuePtr) { - Tcl_WriteObj(errChannel, valuePtr); - } + Tcl_AddErrorInfo(interp, ""); + Tcl_WriteObj(errChannel, Tcl_GetVar2Ex(interp, "errorInfo", + NULL, TCL_GLOBAL_ONLY)); Tcl_WriteChars(errChannel, "\n", 1); - Tcl_DecrRefCount(options); } exitCode = 1; } @@ -460,19 +307,16 @@ Tcl_Main( } /* - * We're running interactively. Source a user-specific startup file if the - * application specified one and if the file exists. + * We're running interactively. Source a user-specific startup + * file if the application specified one and if the file exists. */ Tcl_SourceRCFile(interp); - if (Tcl_LimitExceeded(interp)) { - goto done; - } /* - * Process commands from stdin until there's an end-of-file. Note that we - * need to fetch the standard channels again after every eval, since they - * may have been changed. + * Process commands from stdin until there's an end-of-file. Note + * that we need to fetch the standard channels again after every + * eval, since they may have been changed. */ commandPtr = Tcl_NewObj(); @@ -481,7 +325,6 @@ Tcl_Main( /* * Get a new value for tty if anyone writes to ::tcl_interactive */ - Tcl_LinkVar(interp, "tcl_interactive", (char *) &tty, TCL_LINK_BOOLEAN); inChannel = Tcl_GetStdChannel(TCL_STDIN); outChannel = Tcl_GetStdChannel(TCL_STDOUT); @@ -492,12 +335,9 @@ Tcl_Main( if (Tcl_InterpDeleted(interp)) { break; } - if (Tcl_LimitExceeded(interp)) { - break; - } inChannel = Tcl_GetStdChannel(TCL_STDIN); if (inChannel == (Tcl_Channel) NULL) { - break; + break; } } if (Tcl_IsShared(commandPtr)) { @@ -505,32 +345,32 @@ Tcl_Main( commandPtr = Tcl_DuplicateObj(commandPtr); Tcl_IncrRefCount(commandPtr); } - length = Tcl_GetsObj(inChannel, commandPtr); + length = Tcl_GetsObj(inChannel, commandPtr); if (length < 0) { if (Tcl_InputBlocked(inChannel)) { + /* * This can only happen if stdin has been set to - * non-blocking. In that case cycle back and try again. - * This sets up a tight polling loop (since we have no - * event loop running). If this causes bad CPU hogging, - * we might try toggling the blocking on stdin instead. + * non-blocking. In that case cycle back and try + * again. This sets up a tight polling loop (since + * we have no event loop running). If this causes + * bad CPU hogging, we might try toggling the blocking + * on stdin instead. */ continue; } - /* + /* * Either EOF, or an error on stdin; we're done */ break; } - /* - * Add the newline removed by Tcl_GetsObj back to the string. - * Have to add it back before testing completeness, because - * it can make a difference. [Bug 1775878]. - */ + /* + * Add the newline removed by Tcl_GetsObj back to the string. + */ if (Tcl_IsShared(commandPtr)) { Tcl_DecrRefCount(commandPtr); @@ -544,12 +384,6 @@ Tcl_Main( } prompt = PROMPT_START; - /* - * The final newline is syntactically redundant, and causes - * some error messages troubles deeper in, so lop it back off. - */ - Tcl_GetStringFromObj(commandPtr, &length); - Tcl_SetObjLength(commandPtr, --length); code = Tcl_RecordAndEvalObj(interp, commandPtr, TCL_EVAL_GLOBAL); inChannel = Tcl_GetStdChannel(TCL_STDIN); outChannel = Tcl_GetStdChannel(TCL_STDOUT); @@ -562,7 +396,7 @@ Tcl_Main( Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp)); Tcl_WriteChars(errChannel, "\n", 1); } - } else if (tty) { + } else if (tty) { resultPtr = Tcl_GetObjResult(interp); Tcl_IncrRefCount(resultPtr); Tcl_GetStringFromObj(resultPtr, &length); @@ -574,18 +408,18 @@ Tcl_Main( } } else { /* (mainLoopProc != NULL) */ /* - * If a main loop has been defined while running interactively, we - * want to start a fileevent based prompt by establishing a + * If a main loop has been defined while running interactively, + * we want to start a fileevent based prompt by establishing a * channel handler for stdin. */ InteractiveState *isPtr = NULL; if (inChannel) { - if (tty) { + if (tty) { Prompt(interp, &prompt); - } - isPtr = (InteractiveState *) + } + isPtr = (InteractiveState *) ckalloc((int) sizeof(InteractiveState)); isPtr->input = inChannel; isPtr->tty = tty; @@ -624,8 +458,8 @@ Tcl_Main( #ifdef TCL_MEM_DEBUG /* - * This code here only for the (unsupported and deprecated) [checkmem] - * command. + * This code here only for the (unsupported and deprecated) + * [checkmem] command. */ if (tclMemDumpFileName != NULL) { @@ -635,13 +469,13 @@ Tcl_Main( #endif } - done: - if ((exitCode == 0) && (mainLoopProc != NULL) - && !Tcl_LimitExceeded(interp)) { + done: + if ((exitCode == 0) && (mainLoopProc != NULL)) { + /* - * If everything has gone OK so far, call the main loop proc, if it - * exists. Packages (like Tk) can set it to start processing events at - * this point. + * If everything has gone OK so far, call the main loop proc, + * if it exists. Packages (like Tk) can set it to start processing + * events at this point. */ (*mainLoopProc)(); @@ -652,35 +486,32 @@ Tcl_Main( } /* - * Rather than calling exit, invoke the "exit" command so that users can - * replace "exit" with some other command to do additional cleanup on - * exit. The Tcl_EvalObjEx call should never return. + * Rather than calling exit, invoke the "exit" command so that + * users can replace "exit" with some other command to do additional + * cleanup on exit. The Tcl_Eval call should never return. */ if (!Tcl_InterpDeleted(interp)) { - if (!Tcl_LimitExceeded(interp)) { - Tcl_Obj *cmd = Tcl_ObjPrintf("exit %d", exitCode); - Tcl_IncrRefCount(cmd); - Tcl_EvalObjEx(interp, cmd, TCL_EVAL_GLOBAL); - Tcl_DecrRefCount(cmd); - } - - /* - * If Tcl_EvalObjEx returns, trying to eval [exit], something unusual - * is happening. Maybe interp has been deleted; maybe [exit] was - * redefined, maybe we've blown up because of an exceeded limit. We - * still want to cleanup and exit. - */ - - if (!Tcl_InterpDeleted(interp)) { - Tcl_DeleteInterp(interp); - } + char buffer[TCL_INTEGER_SPACE + 5]; + sprintf(buffer, "exit %d", exitCode); + Tcl_Eval(interp, buffer); + + /* + * If Tcl_Eval returns, trying to eval [exit], something + * unusual is happening. Maybe interp has been deleted; + * maybe [exit] was redefined. We still want to cleanup + * and exit. + */ + + if (!Tcl_InterpDeleted(interp)) { + Tcl_DeleteInterp(interp); + } } - Tcl_SetStartupScript(NULL, NULL); + TclSetStartupScriptPath(NULL); /* - * If we get here, the master interp has been deleted. Allow its - * destruction with the last matching Tcl_Release. + * If we get here, the master interp has been deleted. Allow + * its destruction with the last matching Tcl_Release. */ Tcl_Release((ClientData) interp); @@ -692,21 +523,21 @@ Tcl_Main( * * Tcl_SetMainLoop -- * - * Sets an alternative main loop function. + * Sets an alternative main loop procedure. * * Results: - * Returns the previously defined main loop function. + * Returns the previously defined main loop procedure. * * Side effects: - * This function will be called before Tcl exits, allowing for the - * creation of an event loop. + * This procedure will be called before Tcl exits, allowing for + * the creation of an event loop. * *--------------------------------------------------------------- */ void -Tcl_SetMainLoop( - Tcl_MainLoopProc *proc) +Tcl_SetMainLoop(proc) + Tcl_MainLoopProc *proc; { mainLoopProc = proc; } @@ -716,25 +547,26 @@ Tcl_SetMainLoop( * * StdinProc -- * - * This function is invoked by the event dispatcher whenever standard - * input becomes readable. It grabs the next line of input characters, - * adds them to a command being assembled, and executes the command if - * it's complete. + * This procedure is invoked by the event dispatcher whenever + * standard input becomes readable. It grabs the next line of + * input characters, adds them to a command being assembled, and + * executes the command if it's complete. * * Results: * None. * * Side effects: - * Could be almost arbitrary, depending on the command that's typed. + * Could be almost arbitrary, depending on the command that's + * typed. * *---------------------------------------------------------------------- */ /* ARGSUSED */ static void -StdinProc( - ClientData clientData, /* The state of interactive cmd line */ - int mask) /* Not used. */ +StdinProc(clientData, mask) + ClientData clientData; /* The state of interactive cmd line */ + int mask; /* Not used. */ { InteractiveState *isPtr = (InteractiveState *) clientData; Tcl_Channel chan = isPtr->input; @@ -754,11 +586,10 @@ StdinProc( } if (isPtr->tty) { /* - * Would be better to find a way to exit the mainLoop? Or perhaps - * evaluate [exit]? Leaving as is for now due to compatibility - * concerns. + * Would be better to find a way to exit the mainLoop? + * Or perhaps evaluate [exit]? Leaving as is for now due + * to compatibility concerns. */ - Tcl_Exit(0); } Tcl_DeleteChannelHandler(chan, StdinProc, (ClientData) isPtr); @@ -772,18 +603,17 @@ StdinProc( } Tcl_AppendToObj(commandPtr, "\n", 1); if (!TclObjCommandComplete(commandPtr)) { - isPtr->prompt = PROMPT_CONTINUE; - goto prompt; + isPtr->prompt = PROMPT_CONTINUE; + goto prompt; } isPtr->prompt = PROMPT_START; - Tcl_GetStringFromObj(commandPtr, &length); - Tcl_SetObjLength(commandPtr, --length); /* * Disable the stdin channel handler while evaluating the command; - * otherwise if the command re-enters the event loop we might process - * commands from stdin before the current command is finished. Among other - * things, this will trash the text of the command being evaluated. + * otherwise if the command re-enters the event loop we might + * process commands from stdin before the current command is + * finished. Among other things, this will trash the text of the + * command being evaluated. */ Tcl_CreateChannelHandler(chan, 0, StdinProc, (ClientData) isPtr); @@ -818,7 +648,7 @@ StdinProc( * If a tty stdin is still around, output a prompt. */ - prompt: + prompt: if (isPtr->tty && (isPtr->input != (Tcl_Channel) NULL)) { Prompt(interp, &(isPtr->prompt)); isPtr->input = Tcl_GetStdChannel(TCL_STDIN); @@ -830,24 +660,25 @@ StdinProc( * * Prompt -- * - * Issue a prompt on standard output, or invoke a script to issue the - * prompt. + * Issue a prompt on standard output, or invoke a script + * to issue the prompt. * * Results: * None. * * Side effects: - * A prompt gets output, and a Tcl script may be evaluated in interp. + * A prompt gets output, and a Tcl script may be evaluated + * in interp. * *---------------------------------------------------------------------- */ static void -Prompt( - Tcl_Interp *interp, /* Interpreter to use for prompting. */ - PromptType *promptPtr) /* Points to type of prompt to print. Filled - * with PROMPT_NONE after a prompt is - * printed. */ +Prompt(interp, promptPtr) + Tcl_Interp *interp; /* Interpreter to use for prompting. */ + PromptType *promptPtr; /* Points to type of prompt to print. + * Filled with PROMPT_NONE after a + * prompt is printed. */ { Tcl_Obj *promptCmdPtr; int code; @@ -860,17 +691,15 @@ Prompt( promptCmdPtr = Tcl_GetVar2Ex(interp, ((*promptPtr == PROMPT_CONTINUE) ? "tcl_prompt2" : "tcl_prompt1"), NULL, TCL_GLOBAL_ONLY); - if (Tcl_InterpDeleted(interp)) { return; } if (promptCmdPtr == NULL) { - defaultPrompt: + defaultPrompt: outChannel = Tcl_GetStdChannel(TCL_STDOUT); if ((*promptPtr == PROMPT_START) && (outChannel != (Tcl_Channel) NULL)) { - Tcl_WriteChars(outChannel, DEFAULT_PRIMARY_PROMPT, - strlen(DEFAULT_PRIMARY_PROMPT)); + Tcl_WriteChars(outChannel, "% ", 2); } } else { code = Tcl_EvalObjEx(interp, promptCmdPtr, TCL_EVAL_GLOBAL); @@ -878,25 +707,16 @@ Prompt( Tcl_AddErrorInfo(interp, "\n (script that generates prompt)"); errChannel = Tcl_GetStdChannel(TCL_STDERR); - if (errChannel != (Tcl_Channel) NULL) { - Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp)); - Tcl_WriteChars(errChannel, "\n", 1); - } + if (errChannel != (Tcl_Channel) NULL) { + Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp)); + Tcl_WriteChars(errChannel, "\n", 1); + } goto defaultPrompt; } } - outChannel = Tcl_GetStdChannel(TCL_STDOUT); if (outChannel != (Tcl_Channel) NULL) { Tcl_Flush(outChannel); } *promptPtr = PROMPT_NONE; } - -/* - * Local Variables: - * mode: c - * c-basic-offset: 4 - * fill-column: 78 - * End: - */ |