diff options
Diffstat (limited to 'generic/tclMain.c')
-rw-r--r-- | generic/tclMain.c | 487 |
1 files changed, 296 insertions, 191 deletions
diff --git a/generic/tclMain.c b/generic/tclMain.c index b274f41..f445383 100644 --- a/generic/tclMain.c +++ b/generic/tclMain.c @@ -2,6 +2,11 @@ * tclMain.c -- * * Main program for Tcl shells and other Tcl-based applications. + * This file contains a generic main program for Tcl shells and other + * Tcl-based applications. It can be used as-is for many applications, + * just by supplying a different appInitProc function for each specific + * application. Or, it can be used as a template for creating new main + * programs for Tcl applications. * * Copyright (c) 1988-1994 The Regents of the University of California. * Copyright (c) 1994-1997 Sun Microsystems, Inc. @@ -9,10 +14,24 @@ * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. - * - * RCS: @(#) $Id: tclMain.c,v 1.51 2010/09/23 18:08:35 dgp Exp $ */ +/* + * On Windows, this file needs to be compiled twice, once with TCL_ASCII_MAIN + * defined. This way both Tcl_Main and Tcl_MainExW can be implemented, sharing + * the same source code. + */ + +#if defined(TCL_ASCII_MAIN) +# ifdef UNICODE +# undef UNICODE +# undef _UNICODE +# else +# define UNICODE +# define _UNICODE +# endif +#endif + #include "tclInt.h" /* @@ -22,6 +41,40 @@ #define DEFAULT_PRIMARY_PROMPT "% " /* + * This file can be compiled on Windows in UNICODE mode, as well as on all + * other platforms using the native encoding. This is done by using the normal + * Windows functions like _tcscmp, but on platforms which don't have <tchar.h> + * we have to translate that to strcmp here. + */ + +#ifndef __WIN32__ +# define TCHAR char +# define TEXT(arg) arg +# define _tcscmp strcmp +#endif + +/* + * Further on, in UNICODE mode we just use Tcl_NewUnicodeObj, otherwise + * NewNativeObj is needed (which provides proper conversion from native + * encoding to UTF-8). + */ + +#ifdef UNICODE +# define NewNativeObj Tcl_NewUnicodeObj +#else /* !UNICODE */ +static inline Tcl_Obj * +NewNativeObj( + char *string, + int length) +{ + Tcl_DString ds; + + Tcl_ExternalToUtfDString(NULL, string, length, &ds); + return TclDStringToObj(&ds); +} +#endif /* !UNICODE */ + +/* * 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). @@ -43,7 +96,6 @@ typedef struct { /* Any installed main loop handler. The main * extension that installs these is Tk. */ } ThreadSpecificData; -static Tcl_ThreadDataKey dataKey; /* * Structure definition for information used to keep the state of an @@ -74,10 +126,14 @@ typedef struct InteractiveState { * Forward declarations for functions defined later in this file. */ -static Tcl_MainLoopProc * GetMainLoop(void); -static void Prompt(Tcl_Interp *interp, PromptType *promptPtr); +MODULE_SCOPE Tcl_MainLoopProc *TclGetMainLoop(void); +static void Prompt(Tcl_Interp *interp, InteractiveState *isPtr); static void StdinProc(ClientData clientData, int mask); +static void FreeMainInterp(ClientData clientData); +#ifndef TCL_ASCII_MAIN +static Tcl_ThreadDataKey dataKey; + /* *---------------------------------------------------------------------- * @@ -185,7 +241,7 @@ Tcl_SourceRCFile( { Tcl_DString temp; const char *fileName; - Tcl_Channel errChannel; + Tcl_Channel chan; fileName = Tcl_GetVar(interp, "tcl_rcFileName", TCL_GLOBAL_ONLY); if (fileName != NULL) { @@ -209,10 +265,10 @@ Tcl_SourceRCFile( if (c != 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); + chan = Tcl_GetStdChannel(TCL_STDERR); + if (chan) { + Tcl_WriteObj(chan, Tcl_GetObjResult(interp)); + Tcl_WriteChars(chan, "\n", 1); } } } @@ -220,10 +276,11 @@ Tcl_SourceRCFile( Tcl_DStringFree(&temp); } } +#endif /* !TCL_ASCII_MAIN */ /*---------------------------------------------------------------------- * - * Tcl_Main -- + * Tcl_Main, Tcl_MainEx -- * * Main program for tclsh and most other Tcl-based applications. * @@ -240,28 +297,28 @@ Tcl_SourceRCFile( */ void -Tcl_Main( +Tcl_MainEx( int argc, /* Number of arguments. */ - char **argv, /* Array of argument strings. */ - Tcl_AppInitProc *appInitProc) + TCHAR **argv, /* Array of argument strings. */ + Tcl_AppInitProc *appInitProc, /* Application-specific initialization * function to call after most initialization * but before starting to execute commands. */ + Tcl_Interp *interp) { - Tcl_Obj *path, *resultPtr, *argvPtr, *commandPtr = NULL; + Tcl_Obj *path, *resultPtr, *argvPtr, *appName; const char *encodingName = NULL; - PromptType prompt = PROMPT_START; - int code, length, tty, exitCode = 0; + int code, exitCode = 0; Tcl_MainLoopProc *mainLoopProc; - Tcl_Channel inChannel, outChannel, errChannel; - Tcl_Interp *interp; - Tcl_DString appName; - - Tcl_FindExecutable(argv[0]); + Tcl_Channel chan; + InteractiveState is; - interp = Tcl_CreateInterp(); Tcl_InitMemory(interp); + is.interp = interp; + is.prompt = PROMPT_START; + is.commandPtr = Tcl_NewObj(); + /* * If the application has not already set a startup script, parse the * first few command line arguments to determine the script path and @@ -271,18 +328,21 @@ Tcl_Main( if (NULL == Tcl_GetStartupScript(NULL)) { /* * Check whether first 3 args (argv[1] - argv[3]) look like - * -encoding ENCODING FILENAME + * -encoding ENCODING FILENAME * or like - * FILENAME + * FILENAME */ - if ((argc > 3) && (0 == strcmp("-encoding", argv[1])) + if ((argc > 3) && (0 == _tcscmp(TEXT("-encoding"), argv[1])) && ('-' != argv[3][0])) { - Tcl_SetStartupScript(Tcl_NewStringObj(argv[3], -1), argv[2]); + Tcl_Obj *value = NewNativeObj(argv[2], -1); + Tcl_SetStartupScript(NewNativeObj(argv[3], -1), + Tcl_GetString(value)); + Tcl_DecrRefCount(value); argc -= 3; argv += 3; } else if ((argc > 1) && ('-' != argv[1][0])) { - Tcl_SetStartupScript(Tcl_NewStringObj(argv[1], -1), NULL); + Tcl_SetStartupScript(NewNativeObj(argv[1], -1), NULL); argc--; argv++; } @@ -290,16 +350,11 @@ Tcl_Main( path = Tcl_GetStartupScript(&encodingName); if (path == NULL) { - Tcl_ExternalToUtfDString(NULL, argv[0], -1, &appName); + appName = NewNativeObj(argv[0], -1); } 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); + appName = path; } - Tcl_SetVar(interp, "argv0", Tcl_DStringValue(&appName), TCL_GLOBAL_ONLY); - Tcl_DStringFree(&appName); + Tcl_SetVar2Ex(interp, "argv0", NULL, appName, TCL_GLOBAL_ONLY); argc--; argv++; @@ -307,12 +362,7 @@ Tcl_Main( argvPtr = Tcl_NewListObj(0, NULL); while (argc--) { - Tcl_DString ds; - - Tcl_ExternalToUtfDString(NULL, *argv++, -1, &ds); - Tcl_ListObjAppendElement(NULL, argvPtr, Tcl_NewStringObj( - Tcl_DStringValue(&ds), Tcl_DStringLength(&ds))); - Tcl_DStringFree(&ds); + Tcl_ListObjAppendElement(NULL, argvPtr, NewNativeObj(*argv++, -1)); } Tcl_SetVar2Ex(interp, "argv", NULL, argvPtr, TCL_GLOBAL_ONLY); @@ -320,9 +370,9 @@ Tcl_Main( * Set the "tcl_interactive" variable. */ - tty = isatty(0); - Tcl_SetVar(interp, "tcl_interactive", ((path == NULL) && tty) ? "1" : "0", - TCL_GLOBAL_ONLY); + is.tty = isatty(0); + Tcl_SetVar2Ex(interp, "tcl_interactive", NULL, + Tcl_NewIntObj(!path && is.tty), TCL_GLOBAL_ONLY); /* * Invoke application-specific initialization. @@ -330,12 +380,12 @@ Tcl_Main( Tcl_Preserve(interp); if (appInitProc(interp) != TCL_OK) { - errChannel = Tcl_GetStdChannel(TCL_STDERR); - if (errChannel) { - Tcl_WriteChars(errChannel, + chan = Tcl_GetStdChannel(TCL_STDERR); + if (chan) { + Tcl_WriteChars(chan, "application-specific initialization failed: ", -1); - Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp)); - Tcl_WriteChars(errChannel, "\n", 1); + Tcl_WriteObj(chan, Tcl_GetObjResult(interp)); + Tcl_WriteChars(chan, "\n", 1); } } if (Tcl_InterpDeleted(interp)) { @@ -344,18 +394,27 @@ Tcl_Main( if (Tcl_LimitExceeded(interp)) { goto done; } + if (TclFullFinalizationRequested()) { + /* + * Arrange for final deletion of the main interp + */ + + /* ARGH Munchhausen effect */ + Tcl_CreateExitHandler(FreeMainInterp, interp); + } /* - * If a script file was specified then just source that file and quit. - * Must fetch it again, as the appInitProc might have reset it. + * Invoke the script specified on the command line, if any. Must fetch it + * again, as the appInitProc might have reset it. */ path = Tcl_GetStartupScript(&encodingName); if (path != NULL) { + Tcl_ResetResult(interp); code = Tcl_FSEvalFileEx(interp, path, encodingName); if (code != TCL_OK) { - errChannel = Tcl_GetStdChannel(TCL_STDERR); - if (errChannel) { + chan = Tcl_GetStdChannel(TCL_STDERR); + if (chan) { Tcl_Obj *options = Tcl_GetReturnOptions(interp, code); Tcl_Obj *keyPtr, *valuePtr; @@ -365,9 +424,9 @@ Tcl_Main( Tcl_DecrRefCount(keyPtr); if (valuePtr) { - Tcl_WriteObj(errChannel, valuePtr); + Tcl_WriteObj(chan, valuePtr); } - Tcl_WriteChars(errChannel, "\n", 1); + Tcl_WriteChars(chan, "\n", 1); Tcl_DecrRefCount(options); } exitCode = 1; @@ -391,40 +450,40 @@ Tcl_Main( * may have been changed. */ - commandPtr = Tcl_NewObj(); - Tcl_IncrRefCount(commandPtr); + Tcl_IncrRefCount(is.commandPtr); /* * 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); - while ((inChannel != NULL) && !Tcl_InterpDeleted(interp)) { - mainLoopProc = GetMainLoop(); + Tcl_LinkVar(interp, "tcl_interactive", (char *) &is.tty, TCL_LINK_BOOLEAN); + is.input = Tcl_GetStdChannel(TCL_STDIN); + while ((is.input != NULL) && !Tcl_InterpDeleted(interp)) { + mainLoopProc = TclGetMainLoop(); if (mainLoopProc == NULL) { - if (tty) { - Prompt(interp, &prompt); + int length; + + if (is.tty) { + Prompt(interp, &is); if (Tcl_InterpDeleted(interp)) { break; } if (Tcl_LimitExceeded(interp)) { break; } - inChannel = Tcl_GetStdChannel(TCL_STDIN); - if (inChannel == NULL) { + is.input = Tcl_GetStdChannel(TCL_STDIN); + if (is.input == NULL) { break; } } - if (Tcl_IsShared(commandPtr)) { - Tcl_DecrRefCount(commandPtr); - commandPtr = Tcl_DuplicateObj(commandPtr); - Tcl_IncrRefCount(commandPtr); + if (Tcl_IsShared(is.commandPtr)) { + Tcl_DecrRefCount(is.commandPtr); + is.commandPtr = Tcl_DuplicateObj(is.commandPtr); + Tcl_IncrRefCount(is.commandPtr); } - length = Tcl_GetsObj(inChannel, commandPtr); + length = Tcl_GetsObj(is.input, is.commandPtr); if (length < 0) { - if (Tcl_InputBlocked(inChannel)) { + if (Tcl_InputBlocked(is.input)) { /* * This can only happen if stdin has been set to * non-blocking. In that case cycle back and try again. @@ -449,45 +508,46 @@ Tcl_Main( * a difference. [Bug 1775878] */ - if (Tcl_IsShared(commandPtr)) { - Tcl_DecrRefCount(commandPtr); - commandPtr = Tcl_DuplicateObj(commandPtr); - Tcl_IncrRefCount(commandPtr); + if (Tcl_IsShared(is.commandPtr)) { + Tcl_DecrRefCount(is.commandPtr); + is.commandPtr = Tcl_DuplicateObj(is.commandPtr); + Tcl_IncrRefCount(is.commandPtr); } - Tcl_AppendToObj(commandPtr, "\n", 1); - if (!TclObjCommandComplete(commandPtr)) { - prompt = PROMPT_CONTINUE; + Tcl_AppendToObj(is.commandPtr, "\n", 1); + if (!TclObjCommandComplete(is.commandPtr)) { + is.prompt = PROMPT_CONTINUE; continue; } - prompt = PROMPT_START; + is.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); - errChannel = Tcl_GetStdChannel(TCL_STDERR); - Tcl_DecrRefCount(commandPtr); - commandPtr = Tcl_NewObj(); - Tcl_IncrRefCount(commandPtr); + Tcl_GetStringFromObj(is.commandPtr, &length); + Tcl_SetObjLength(is.commandPtr, --length); + code = Tcl_RecordAndEvalObj(interp, is.commandPtr, + TCL_EVAL_GLOBAL); + is.input = Tcl_GetStdChannel(TCL_STDIN); + Tcl_DecrRefCount(is.commandPtr); + is.commandPtr = Tcl_NewObj(); + Tcl_IncrRefCount(is.commandPtr); if (code != TCL_OK) { - if (errChannel) { - Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp)); - Tcl_WriteChars(errChannel, "\n", 1); + chan = Tcl_GetStdChannel(TCL_STDERR); + if (chan) { + Tcl_WriteObj(chan, Tcl_GetObjResult(interp)); + Tcl_WriteChars(chan, "\n", 1); } - } else if (tty) { + } else if (is.tty) { resultPtr = Tcl_GetObjResult(interp); Tcl_IncrRefCount(resultPtr); Tcl_GetStringFromObj(resultPtr, &length); - if ((length > 0) && outChannel) { - Tcl_WriteObj(outChannel, resultPtr); - Tcl_WriteChars(outChannel, "\n", 1); + chan = Tcl_GetStdChannel(TCL_STDOUT); + if ((length > 0) && chan) { + Tcl_WriteObj(chan, resultPtr); + Tcl_WriteChars(chan, "\n", 1); } Tcl_DecrRefCount(resultPtr); } @@ -498,65 +558,40 @@ Tcl_Main( * channel handler for stdin. */ - InteractiveState *isPtr = NULL; - - if (inChannel) { - if (tty) { - Prompt(interp, &prompt); + if (is.input) { + if (is.tty) { + Prompt(interp, &is); } - isPtr = (InteractiveState *) - ckalloc(sizeof(InteractiveState)); - isPtr->input = inChannel; - isPtr->tty = tty; - isPtr->commandPtr = commandPtr; - isPtr->prompt = prompt; - isPtr->interp = interp; - - Tcl_UnlinkVar(interp, "tcl_interactive"); - Tcl_LinkVar(interp, "tcl_interactive", (char *) &isPtr->tty, - TCL_LINK_BOOLEAN); - - Tcl_CreateChannelHandler(inChannel, TCL_READABLE, StdinProc, - isPtr); + + Tcl_CreateChannelHandler(is.input, TCL_READABLE, + StdinProc, &is); } mainLoopProc(); Tcl_SetMainLoop(NULL); - if (inChannel) { - tty = isPtr->tty; - Tcl_UnlinkVar(interp, "tcl_interactive"); - Tcl_LinkVar(interp, "tcl_interactive", (char *) &tty, - TCL_LINK_BOOLEAN); - prompt = isPtr->prompt; - commandPtr = isPtr->commandPtr; - if (isPtr->input != NULL) { - Tcl_DeleteChannelHandler(isPtr->input, StdinProc, isPtr); - } - ckfree((char *) isPtr); + if (is.input) { + Tcl_DeleteChannelHandler(is.input, StdinProc, &is); } - inChannel = Tcl_GetStdChannel(TCL_STDIN); - outChannel = Tcl_GetStdChannel(TCL_STDOUT); - errChannel = Tcl_GetStdChannel(TCL_STDERR); + is.input = Tcl_GetStdChannel(TCL_STDIN); } -#ifdef TCL_MEM_DEBUG /* * This code here only for the (unsupported and deprecated) [checkmem] * command. */ +#ifdef TCL_MEM_DEBUG if (tclMemDumpFileName != NULL) { Tcl_SetMainLoop(NULL); Tcl_DeleteInterp(interp); } -#endif +#endif /* TCL_MEM_DEBUG */ } done: - mainLoopProc = GetMainLoop(); - if ((exitCode == 0) && (mainLoopProc != NULL) - && !Tcl_LimitExceeded(interp)) { + mainLoopProc = TclGetMainLoop(); + if ((exitCode == 0) && mainLoopProc && !Tcl_LimitExceeded(interp)) { /* * 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 @@ -566,8 +601,8 @@ Tcl_Main( mainLoopProc(); Tcl_SetMainLoop(NULL); } - if (commandPtr != NULL) { - Tcl_DecrRefCount(commandPtr); + if (is.commandPtr != NULL) { + Tcl_DecrRefCount(is.commandPtr); } /* @@ -576,37 +611,42 @@ Tcl_Main( * exit. The Tcl_EvalObjEx 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); - } + if (!Tcl_InterpDeleted(interp) && !Tcl_LimitExceeded(interp)) { + Tcl_Obj *cmd = Tcl_ObjPrintf("exit %d", exitCode); + + Tcl_IncrRefCount(cmd); + Tcl_EvalObjEx(interp, cmd, TCL_EVAL_GLOBAL); + Tcl_DecrRefCount(cmd); } - Tcl_SetStartupScript(NULL, NULL); /* - * If we get here, the master interp has been deleted. Allow its - * destruction with the last matching Tcl_Release. + * 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. */ - Tcl_Release(interp); Tcl_Exit(exitCode); } + +#if (TCL_MAJOR_VERSION == 8) && !defined(UNICODE) +#undef Tcl_Main +extern DLLEXPORT void +Tcl_Main( + 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. */ +{ + Tcl_FindExecutable(argv[0]); + Tcl_MainEx(argc, argv, appInitProc, Tcl_CreateInterp()); +} +#endif /* TCL_MAJOR_VERSION == 8 && !UNICODE */ +#ifndef TCL_ASCII_MAIN + /* *--------------------------------------------------------------- * @@ -636,7 +676,7 @@ Tcl_SetMainLoop( /* *--------------------------------------------------------------- * - * GetMainLoop -- + * TclGetMainLoop -- * * Returns the current alternative main loop function. * @@ -652,8 +692,8 @@ Tcl_SetMainLoop( *--------------------------------------------------------------- */ -static Tcl_MainLoopProc * -GetMainLoop(void) +Tcl_MainLoopProc * +TclGetMainLoop(void) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -663,6 +703,44 @@ GetMainLoop(void) /* *---------------------------------------------------------------------- * + * TclFullFinalizationRequested -- + * + * This function returns true when either -DPURIFY is specified, or the + * environment variable TCL_FINALIZE_ON_EXIT is set and not "0". This + * predicate is called at places affecting the exit sequence, so that the + * default behavior is a fast and deadlock-free exit, and the modified + * behavior is a more thorough finalization for debugging purposes (leak + * hunting etc). + * + * Results: + * A boolean. + * + *---------------------------------------------------------------------- + */ + +MODULE_SCOPE int +TclFullFinalizationRequested(void) +{ +#ifdef PURIFY + return 1; +#else + const char *fin; + Tcl_DString ds; + int finalize = 0; + + fin = TclGetEnv("TCL_FINALIZE_ON_EXIT", &ds); + finalize = ((fin != NULL) && strcmp(fin, "0")); + if (fin != NULL) { + Tcl_DStringFree(&ds); + } + return finalize; +#endif /* PURIFY */ +} +#endif /* !TCL_ASCII_MAIN */ + +/* + *---------------------------------------------------------------------- + * * StdinProc -- * * This function is invoked by the event dispatcher whenever standard @@ -685,11 +763,11 @@ StdinProc( ClientData clientData, /* The state of interactive cmd line */ int mask) /* Not used. */ { + int code, length; InteractiveState *isPtr = clientData; Tcl_Channel chan = isPtr->input; Tcl_Obj *commandPtr = isPtr->commandPtr; Tcl_Interp *interp = isPtr->interp; - int code, length; if (Tcl_IsShared(commandPtr)) { Tcl_DecrRefCount(commandPtr); @@ -745,21 +823,21 @@ StdinProc( Tcl_CreateChannelHandler(chan, TCL_READABLE, StdinProc, isPtr); } if (code != TCL_OK) { - Tcl_Channel errChannel = Tcl_GetStdChannel(TCL_STDERR); + chan = Tcl_GetStdChannel(TCL_STDERR); - if (errChannel != NULL) { - Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp)); - Tcl_WriteChars(errChannel, "\n", 1); + if (chan != NULL) { + Tcl_WriteObj(chan, Tcl_GetObjResult(interp)); + Tcl_WriteChars(chan, "\n", 1); } } else if (isPtr->tty) { Tcl_Obj *resultPtr = Tcl_GetObjResult(interp); - Tcl_Channel outChannel = Tcl_GetStdChannel(TCL_STDOUT); + chan = Tcl_GetStdChannel(TCL_STDOUT); Tcl_IncrRefCount(resultPtr); Tcl_GetStringFromObj(resultPtr, &length); - if ((length >0) && (outChannel != NULL)) { - Tcl_WriteObj(outChannel, resultPtr); - Tcl_WriteChars(outChannel, "\n", 1); + if ((length > 0) && (chan != NULL)) { + Tcl_WriteObj(chan, resultPtr); + Tcl_WriteChars(chan, "\n", 1); } Tcl_DecrRefCount(resultPtr); } @@ -770,7 +848,7 @@ StdinProc( prompt: if (isPtr->tty && (isPtr->input != NULL)) { - Prompt(interp, &isPtr->prompt); + Prompt(interp, isPtr); isPtr->input = Tcl_GetStdChannel(TCL_STDIN); } } @@ -795,20 +873,19 @@ StdinProc( 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. */ + InteractiveState *isPtr) /* InteractiveState. Filled with PROMPT_NONE + * after a prompt is printed. */ { Tcl_Obj *promptCmdPtr; int code; - Tcl_Channel outChannel, errChannel; + Tcl_Channel chan; - if (*promptPtr == PROMPT_NONE) { + if (isPtr->prompt == PROMPT_NONE) { return; } promptCmdPtr = Tcl_GetVar2Ex(interp, - ((*promptPtr == PROMPT_CONTINUE) ? "tcl_prompt2" : "tcl_prompt1"), + (isPtr->prompt==PROMPT_CONTINUE ? "tcl_prompt2" : "tcl_prompt1"), NULL, TCL_GLOBAL_ONLY); if (Tcl_InterpDeleted(interp)) { @@ -816,30 +893,58 @@ Prompt( } if (promptCmdPtr == NULL) { defaultPrompt: - outChannel = Tcl_GetStdChannel(TCL_STDOUT); - if ((*promptPtr == PROMPT_START) && (outChannel != NULL)) { - Tcl_WriteChars(outChannel, DEFAULT_PRIMARY_PROMPT, - strlen(DEFAULT_PRIMARY_PROMPT)); + if (isPtr->prompt == PROMPT_START) { + chan = Tcl_GetStdChannel(TCL_STDOUT); + if (chan != NULL) { + Tcl_WriteChars(chan, DEFAULT_PRIMARY_PROMPT, + strlen(DEFAULT_PRIMARY_PROMPT)); + } } } else { code = Tcl_EvalObjEx(interp, promptCmdPtr, TCL_EVAL_GLOBAL); if (code != TCL_OK) { Tcl_AddErrorInfo(interp, "\n (script that generates prompt)"); - errChannel = Tcl_GetStdChannel(TCL_STDERR); - if (errChannel != NULL) { - Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp)); - Tcl_WriteChars(errChannel, "\n", 1); + chan = Tcl_GetStdChannel(TCL_STDERR); + if (chan != NULL) { + Tcl_WriteObj(chan, Tcl_GetObjResult(interp)); + Tcl_WriteChars(chan, "\n", 1); } goto defaultPrompt; } } - outChannel = Tcl_GetStdChannel(TCL_STDOUT); - if (outChannel != NULL) { - Tcl_Flush(outChannel); + chan = Tcl_GetStdChannel(TCL_STDOUT); + if (chan != NULL) { + Tcl_Flush(chan); } - *promptPtr = PROMPT_NONE; + isPtr->prompt = PROMPT_NONE; +} + +/* + *---------------------------------------------------------------------- + * + * FreeMainInterp -- + * + * Exit handler used to cleanup the main interpreter and ancillary + * startup script storage at exit. + * + *---------------------------------------------------------------------- + */ + +static void +FreeMainInterp( + ClientData clientData) +{ + Tcl_Interp *interp = clientData; + + /*if (TclInExit()) return;*/ + + if (!Tcl_InterpDeleted(interp)) { + Tcl_DeleteInterp(interp); + } + Tcl_SetStartupScript(NULL, NULL); + Tcl_Release(interp); } /* |