summaryrefslogtreecommitdiffstats
path: root/generic/tclMain.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclMain.c')
-rw-r--r--generic/tclMain.c449
1 files changed, 246 insertions, 203 deletions
diff --git a/generic/tclMain.c b/generic/tclMain.c
index 7caadd1..360f5e9 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.
@@ -11,11 +16,12 @@
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
-/**
- * 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.
+/*
+ * 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
@@ -35,33 +41,37 @@
#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.
+ * 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__
+
+#ifndef _WIN32
# define TCHAR char
# define TEXT(arg) arg
# define _tcscmp strcmp
-# define _tcslen strlen
-# define _tcsncmp strncmp
#endif
/*
- * Further on, in UNICODE mode, we need to use functions like
- * Tcl_GetUnicodeFromObj, while otherwise Tcl_GetStringFromObj
- * is needed. Those macro's assure that the right functions
- * are used depending on the mode.
+ * Further on, in UNICODE mode we just use Tcl_NewUnicodeObj, otherwise
+ * NewNativeObj is needed (which provides proper conversion from native
+ * encoding to UTF-8).
*/
-#ifndef UNICODE
-# undef Tcl_GetUnicodeFromObj
-# define Tcl_GetUnicodeFromObj Tcl_GetStringFromObj
-# undef Tcl_NewUnicodeObj
-# define Tcl_NewUnicodeObj Tcl_NewStringObj
-# undef Tcl_WinTCharToUtf
-# define Tcl_WinTCharToUtf(a,b,c) Tcl_ExternalToUtfDString(NULL,a,b,c)
+
+#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 */
/*
@@ -117,11 +127,13 @@ typedef struct InteractiveState {
*/
MODULE_SCOPE Tcl_MainLoopProc *TclGetMainLoop(void);
-static void Prompt(Tcl_Interp *interp, PromptType *promptPtr);
+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;
+
/*
*----------------------------------------------------------------------
*
@@ -229,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) {
@@ -253,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);
}
}
}
@@ -294,16 +306,22 @@ Tcl_MainEx(
* 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_DString appName;
+ Tcl_Channel chan;
+ InteractiveState is;
+
+ TclpSetInitialEncodings();
+ TclpFindExecutable((const char *)argv[0]);
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
@@ -319,14 +337,15 @@ Tcl_MainEx(
*/
if ((argc > 3) && (0 == _tcscmp(TEXT("-encoding"), argv[1]))
- && (TEXT('-') != argv[3][0])) {
- Tcl_Obj *value = Tcl_NewUnicodeObj(argv[2], -1);
- Tcl_SetStartupScript(Tcl_NewUnicodeObj(argv[3], -1), Tcl_GetString(value));
+ && ('-' != argv[3][0])) {
+ 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) && (TEXT('-') != argv[1][0])) {
- Tcl_SetStartupScript(Tcl_NewUnicodeObj(argv[1], -1), NULL);
+ } else if ((argc > 1) && ('-' != argv[1][0])) {
+ Tcl_SetStartupScript(NewNativeObj(argv[1], -1), NULL);
argc--;
argv++;
}
@@ -334,16 +353,11 @@ Tcl_MainEx(
path = Tcl_GetStartupScript(&encodingName);
if (path == NULL) {
- Tcl_WinTCharToUtf(argv[0], -1, &appName);
+ appName = NewNativeObj(argv[0], -1);
} else {
- const TCHAR *pathName = Tcl_GetUnicodeFromObj(path, &length);
-
- Tcl_WinTCharToUtf(pathName, length * sizeof(TCHAR), &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++;
@@ -351,12 +365,7 @@ Tcl_MainEx(
argvPtr = Tcl_NewListObj(0, NULL);
while (argc--) {
- Tcl_DString ds;
-
- Tcl_WinTCharToUtf(*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);
@@ -364,9 +373,9 @@ Tcl_MainEx(
* 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.
@@ -374,12 +383,12 @@ Tcl_MainEx(
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)) {
@@ -388,18 +397,27 @@ Tcl_MainEx(
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;
@@ -409,9 +427,9 @@ Tcl_MainEx(
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;
@@ -435,40 +453,40 @@ Tcl_MainEx(
* 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)) {
+ 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.
@@ -493,45 +511,46 @@ Tcl_MainEx(
* 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);
}
@@ -542,65 +561,40 @@ Tcl_MainEx(
* 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 = TclGetMainLoop();
- if ((exitCode == 0) && (mainLoopProc != NULL)
- && !Tcl_LimitExceeded(interp)) {
+ 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
@@ -610,8 +604,8 @@ Tcl_MainEx(
mainLoopProc();
Tcl_SetMainLoop(NULL);
}
- if (commandPtr != NULL) {
- Tcl_DecrRefCount(commandPtr);
+ if (is.commandPtr != NULL) {
+ Tcl_DecrRefCount(is.commandPtr);
}
/*
@@ -620,51 +614,38 @@ Tcl_MainEx(
* 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);
}
-#ifndef UNICODE
-void
+#if (TCL_MAJOR_VERSION == 8) && !defined(UNICODE)
+#undef Tcl_Main
+extern DLLEXPORT void
Tcl_Main(
int argc, /* Number of arguments. */
- TCHAR **argv, /* Array of argument strings. */
+ 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());
+ Tcl_MainEx(argc, argv, appInitProc, Tcl_CreateInterp());
}
-#endif
+#endif /* TCL_MAJOR_VERSION == 8 && !UNICODE */
#ifndef TCL_ASCII_MAIN
@@ -720,6 +701,43 @@ TclGetMainLoop(void)
return tsdPtr->mainLoopProc;
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 */
/*
@@ -747,11 +765,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);
@@ -807,21 +825,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);
}
@@ -832,7 +850,7 @@ StdinProc(
prompt:
if (isPtr->tty && (isPtr->input != NULL)) {
- Prompt(interp, &isPtr->prompt);
+ Prompt(interp, isPtr);
isPtr->input = Tcl_GetStdChannel(TCL_STDIN);
}
}
@@ -857,20 +875,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)) {
@@ -878,10 +895,10 @@ Prompt(
}
if (promptCmdPtr == NULL) {
defaultPrompt:
- if (*promptPtr == PROMPT_START) {
- outChannel = Tcl_GetStdChannel(TCL_STDOUT);
- if (outChannel != NULL) {
- Tcl_WriteChars(outChannel, 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));
}
}
@@ -890,20 +907,46 @@ Prompt(
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);
}
/*
generated by cgit v0.12 at 2025-10-23 18:01:10 (GMT)