summaryrefslogtreecommitdiffstats
path: root/generic/tkMain.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tkMain.c')
-rw-r--r--generic/tkMain.c363
1 files changed, 189 insertions, 174 deletions
diff --git a/generic/tkMain.c b/generic/tkMain.c
index 4d348ef..3171ebf 100644
--- a/generic/tkMain.c
+++ b/generic/tkMain.c
@@ -14,29 +14,78 @@
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
-#include "tclInt.h"
+/**
+ * On Windows, this file needs to be compiled twice, once with
+ * TK_ASCII_MAIN defined. This way both Tk_MainEx and Tk_MainExW
+ * can be implemented, sharing the same source code.
+ */
+#if defined(TK_ASCII_MAIN)
+# ifdef UNICODE
+# undef UNICODE
+# undef _UNICODE
+# else
+# define UNICODE
+# define _UNICODE
+# endif
+#endif
+
#include "tkInt.h"
+#include <ctype.h>
+#include <stdio.h>
+#include <string.h>
+#ifdef NO_STDLIB_H
+# include "../compat/stdlib.h"
+#else
+# include <stdlib.h>
+#endif
+
+extern int TkCygwinMainEx(int, char **, Tcl_AppInitProc *, Tcl_Interp *);
+
+/*
+ * The default prompt used when the user has not overridden it.
+ */
+
+#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.
+ */
#ifdef __WIN32__
-#include "tkWinInt.h"
-#include "../win/tclWinPort.h"
+# include "tclInt.h"
+# include "tkWinInt.h"
+#else
+# define TCHAR char
+# define TEXT(arg) arg
+# define _tcscmp strcmp
+# define _tcslen strlen
+# define _tcsncmp strncmp
#endif
+
#ifdef MAC_OSX_TK
#include "tkMacOSXInt.h"
#endif
-extern int TkCygwinMainEx(int, char **, Tcl_AppInitProc *, Tcl_Interp *);
-
-typedef struct ThreadSpecificData {
- Tcl_Interp *interp; /* Interpreter for this thread. */
- Tcl_DString command; /* Used to assemble lines of terminal input
- * into Tcl commands. */
- Tcl_DString line; /* Used to read the next line from the
- * terminal input. */
- int tty; /* Non-zero means standard input is a
- * terminal-like device. Zero means it's a
- * file. */
-} ThreadSpecificData;
-static Tcl_ThreadDataKey dataKey;
+/*
+ * Further on, in UNICODE mode, we need to use Tcl_NewUnicodeObj,
+ * while otherwise NewNativeObj is needed (which provides proper
+ * conversion from native encoding to UTF-8).
+ */
+#ifdef UNICODE
+# define NewNativeObj Tcl_NewUnicodeObj
+#else /* !UNICODE */
+ static Tcl_Obj *NewNativeObj(char *string, int length) {
+ Tcl_Obj *obj;
+ Tcl_DString ds;
+ Tcl_ExternalToUtfDString(NULL, string, length, &ds);
+ obj = Tcl_NewStringObj(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds));
+ Tcl_DStringFree(&ds);
+ return obj;
+}
+#endif /* !UNICODE */
/*
* Declarations for various library functions and variables (don't want to
@@ -53,9 +102,9 @@ static int WinIsTty(int fd) {
/*
* For now, under Windows, we assume we are not running as a console mode
- * app, so we need to use the GUI console. In order to enable this, we
- * always claim to be running on a tty. This probably isn't the right
- * way to do it.
+ * app, so we need to use the GUI console. In order to enable this, we
+ * always claim to be running on a tty. This probably isn't the right way
+ * to do it.
*/
#if !defined(STATIC_BUILD)
@@ -65,35 +114,38 @@ static int WinIsTty(int fd) {
}
#endif
handle = GetStdHandle(STD_INPUT_HANDLE + fd);
-
- if ((handle == INVALID_HANDLE_VALUE) || (handle == 0)
- || (GetFileType(handle) == FILE_TYPE_UNKNOWN)) {
/*
- * If it's a bad or closed handle, then it's been connected
- * to a wish console window.
+ * If it's a bad or closed handle, then it's been connected to a wish
+ * console window. A character file handle is a tty by definition.
*/
-
- return 1;
- } else if (GetFileType(handle) == FILE_TYPE_CHAR) {
- /*
- * A character file handle is a tty by definition.
- */
-
- return 1;
- } else {
- return 0;
- }
+ return (handle == INVALID_HANDLE_VALUE) || (handle == 0)
+ || (GetFileType(handle) == FILE_TYPE_UNKNOWN)
+ || (GetFileType(handle) == FILE_TYPE_CHAR);
}
#else
extern int isatty(int fd);
-extern char * strrchr(CONST char *string, int c);
#endif
+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_DString command; /* Used to assemble lines of terminal input
+ * into Tcl commands. */
+ Tcl_DString line; /* Used to read the next line from the
+ * terminal input. */
+ int gotPartial;
+ Tcl_Interp *interp; /* Interpreter that evaluates interactive
+ * commands. */
+} InteractiveState;
+
/*
* Forward declarations for functions defined later in this file.
*/
-static void Prompt(Tcl_Interp *interp, int partial);
+static void Prompt(Tcl_Interp *interp, InteractiveState *isPtr);
static void StdinProc(ClientData clientData, int mask);
/*
@@ -105,7 +157,7 @@ static void StdinProc(ClientData clientData, int mask);
*
* Results:
* None. This function never returns (it exits the process when it's
- * done.
+ * done).
*
* Side effects:
* This function initializes the Tk world and then starts interpreting
@@ -114,33 +166,33 @@ static void StdinProc(ClientData clientData, int mask);
*
*----------------------------------------------------------------------
*/
+
void
Tk_MainEx(
int argc, /* Number of arguments. */
- char **argv, /* Array of argument strings. */
+ 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, *argvPtr;
- CONST char *encodingName;
+ Tcl_Obj *path, *argvPtr, *appName;
+ const char *encodingName;
int code, nullStdin = 0;
- Tcl_Channel inChannel, outChannel;
- ThreadSpecificData *tsdPtr;
- Tcl_DString appName;
+ Tcl_Channel chan;
+ InteractiveState is;
/*
- * Ensure that we are getting the matching version of Tcl. This is really
+ * Ensure that we are getting a compatible version of Tcl. This is really
* only an issue when Tk is loaded dynamically.
*/
- if (Tcl_InitStubs(interp, "8.5.0", 0) == NULL) {
+ if (Tcl_InitStubs(interp, "8.6.0", 0) == NULL) {
abort();
}
-#if defined(__WIN32__) && !defined(__WIN64__) && !defined(STATIC_BUILD)
+#if defined(__WIN32__) && !defined(__WIN64__) && !defined(UNICODE) && !defined(STATIC_BUILD)
if (tclStubsPtr->reserved9) {
/* We are running win32 Tk under Cygwin, so let's check
@@ -157,7 +209,7 @@ Tk_MainEx(
int i;
for (i = 1; i < argc; ++i) {
- if (!strcmp(argv[i], "-display")) {
+ if (!_tcscmp(argv[i], TEXT("-display"))) {
goto loadCygwinTk;
}
}
@@ -165,19 +217,13 @@ Tk_MainEx(
}
#endif
- tsdPtr = (ThreadSpecificData *)
- Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ Tcl_InitMemory(interp);
- Tcl_FindExecutable(argv[0]);
- tsdPtr->interp = interp;
- Tcl_Preserve((ClientData) interp);
+ is.interp = interp;
+ is.gotPartial = 0;
+ Tcl_Preserve(interp);
-#if defined(__WIN32__) && !defined(STATIC_BUILD)
- if (!tclStubsPtr->reserved9) {
- /* Only initialize console when not running under cygwin */
- Tk_InitConsoleChannels(interp);
- }
-#elif defined(__WIN32__)
+#if defined(__WIN32__) && !defined(__CYGWIN__)
Tk_InitConsoleChannels(interp);
#endif
@@ -187,10 +233,6 @@ Tk_MainEx(
}
#endif
-#ifdef TCL_MEM_DEBUG
- Tcl_InitMemory(interp);
-#endif
-
/*
* If the application has not already set a startup script, parse the
* first few command line arguments to determine the script path and
@@ -202,44 +244,40 @@ Tk_MainEx(
/*
* Check whether first 3 args (argv[1] - argv[3]) look like
- * -encoding ENCODING FILENAME
+ * -encoding ENCODING FILENAME
* or like
- * FILENAME
+ * FILENAME
* or like
- * -file FILENAME (ancient history support only)
+ * -file FILENAME (ancient history support only)
*/
- if ((argc > 3) && (0 == strcmp("-encoding", argv[1]))
- && ('-' != argv[3][0])) {
- Tcl_SetStartupScript(Tcl_NewStringObj(argv[3], -1), argv[2]);
+ if ((argc > 3) && (0 == _tcscmp(TEXT("-encoding"), argv[1]))
+ && (TEXT('-') != 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) && ('-' != argv[1][0])) {
- Tcl_SetStartupScript(Tcl_NewStringObj(argv[1], -1), NULL);
+ } else if ((argc > 1) && (TEXT('-') != argv[1][0])) {
+ Tcl_SetStartupScript(NewNativeObj(argv[1], -1), NULL);
argc--;
argv++;
- } else if ((argc > 2) && (length = strlen(argv[1]))
- && (length > 1) && (0 == strncmp("-file", argv[1], length))
- && ('-' != argv[2][0])) {
- Tcl_SetStartupScript(Tcl_NewStringObj(argv[2], -1), NULL);
+ } else if ((argc > 2) && (length = _tcslen(argv[1]))
+ && (length > 1) && (0 == _tcsncmp(TEXT("-file"), argv[1], length))
+ && (TEXT('-') != argv[2][0])) {
+ Tcl_SetStartupScript(NewNativeObj(argv[2], -1), NULL);
argc -= 2;
argv += 2;
}
}
path = Tcl_GetStartupScript(&encodingName);
- if (NULL == path) {
- Tcl_ExternalToUtfDString(NULL, argv[0], -1, &appName);
+ if (path == NULL) {
+ appName = NewNativeObj(argv[0], -1);
} else {
- int numBytes;
- CONST char *pathName = Tcl_GetStringFromObj(path, &numBytes);
-
- Tcl_ExternalToUtfDString(NULL, pathName, numBytes, &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++;
@@ -247,12 +285,7 @@ Tk_MainEx(
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);
@@ -260,32 +293,30 @@ Tk_MainEx(
* Set the "tcl_interactive" variable.
*/
- tsdPtr->tty = isatty(0);
-
+ is.tty = isatty(0);
#if defined(MAC_OSX_TK)
/*
* On TkAqua, if we don't have a TTY and stdin is a special character file
* of length 0, (e.g. /dev/null, which is what Finder sets when double
* clicking Wish) then use the GUI console.
*/
-
- if (!tsdPtr->tty) {
+
+ if (!is.tty) {
struct stat st;
nullStdin = fstat(0, &st) || (S_ISCHR(st.st_mode) && !st.st_blocks);
}
#endif
- Tcl_SetVar(interp, "tcl_interactive",
- ((path == NULL) && (tsdPtr->tty || nullStdin)) ? "1" : "0",
- TCL_GLOBAL_ONLY);
+ Tcl_SetVar2Ex(interp, "tcl_interactive", NULL,
+ Tcl_NewIntObj(!path && (is.tty || nullStdin)), TCL_GLOBAL_ONLY);
/*
* Invoke application-specific initialization.
*/
- if ((*appInitProc)(interp) != TCL_OK) {
+ if (appInitProc(interp) != TCL_OK) {
TkpDisplayWarning(Tcl_GetStringResult(interp),
- "Application initialization failed");
+ "application-specific initialization failed");
}
/*
@@ -304,12 +335,12 @@ Tk_MainEx(
*/
Tcl_AddErrorInfo(interp, "");
- TkpDisplayWarning(Tcl_GetVar(interp, "errorInfo",
+ TkpDisplayWarning(Tcl_GetVar2(interp, "errorInfo", NULL,
TCL_GLOBAL_ONLY), "Error in startup script");
Tcl_DeleteInterp(interp);
Tcl_Exit(1);
}
- tsdPtr->tty = 0;
+ is.tty = 0;
} else {
/*
@@ -322,22 +353,21 @@ Tk_MainEx(
* Establish a channel handler for stdin.
*/
- inChannel = Tcl_GetStdChannel(TCL_STDIN);
- if (inChannel) {
- Tcl_CreateChannelHandler(inChannel, TCL_READABLE, StdinProc,
- (ClientData) inChannel);
+ is.input = Tcl_GetStdChannel(TCL_STDIN);
+ if (is.input) {
+ Tcl_CreateChannelHandler(is.input, TCL_READABLE, StdinProc, &is);
}
- if (tsdPtr->tty) {
- Prompt(interp, 0);
+ if (is.tty) {
+ Prompt(interp, &is);
}
}
- outChannel = Tcl_GetStdChannel(TCL_STDOUT);
- if (outChannel) {
- Tcl_Flush(outChannel);
+ chan = Tcl_GetStdChannel(TCL_STDOUT);
+ if (chan) {
+ Tcl_Flush(chan);
}
- Tcl_DStringInit(&tsdPtr->command);
- Tcl_DStringInit(&tsdPtr->line);
+ Tcl_DStringInit(&is.command);
+ Tcl_DStringInit(&is.line);
Tcl_ResetResult(interp);
/*
@@ -347,7 +377,7 @@ Tk_MainEx(
Tk_MainLoop();
Tcl_DeleteInterp(interp);
- Tcl_Release((ClientData) interp);
+ Tcl_Release(interp);
Tcl_SetStartupScript(NULL, NULL);
Tcl_Exit(0);
}
@@ -374,37 +404,34 @@ Tk_MainEx(
/* ARGSUSED */
static void
StdinProc(
- ClientData clientData, /* Not used. */
+ ClientData clientData, /* The state of interactive cmd line */
int mask) /* Not used. */
{
- static int gotPartial = 0;
char *cmd;
int code, count;
- Tcl_Channel chan = (Tcl_Channel) clientData;
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
- Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
- Tcl_Interp *interp = tsdPtr->interp;
+ InteractiveState *isPtr = clientData;
+ Tcl_Channel chan = isPtr->input;
+ Tcl_Interp *interp = isPtr->interp;
- count = Tcl_Gets(chan, &tsdPtr->line);
+ count = Tcl_Gets(chan, &isPtr->line);
- if (count < 0 && !gotPartial) {
- if (tsdPtr->tty) {
+ if (count < 0 && !isPtr->gotPartial) {
+ if (isPtr->tty) {
Tcl_Exit(0);
} else {
- Tcl_DeleteChannelHandler(chan, StdinProc, (ClientData) chan);
+ Tcl_DeleteChannelHandler(chan, StdinProc, isPtr);
}
return;
}
- (void) Tcl_DStringAppend(&tsdPtr->command, Tcl_DStringValue(
- &tsdPtr->line), -1);
- cmd = Tcl_DStringAppend(&tsdPtr->command, "\n", -1);
- Tcl_DStringFree(&tsdPtr->line);
+ Tcl_DStringAppend(&isPtr->command, Tcl_DStringValue(&isPtr->line), -1);
+ cmd = Tcl_DStringAppend(&isPtr->command, "\n", -1);
+ Tcl_DStringFree(&isPtr->line);
if (!Tcl_CommandComplete(cmd)) {
- gotPartial = 1;
+ isPtr->gotPartial = 1;
goto prompt;
}
- gotPartial = 0;
+ isPtr->gotPartial = 0;
/*
* Disable the stdin channel handler while evaluating the command;
@@ -413,18 +440,17 @@ StdinProc(
* things, this will trash the text of the command being evaluated.
*/
- Tcl_CreateChannelHandler(chan, 0, StdinProc, (ClientData) chan);
+ Tcl_CreateChannelHandler(chan, 0, StdinProc, isPtr);
code = Tcl_RecordAndEval(interp, cmd, TCL_EVAL_GLOBAL);
- chan = Tcl_GetStdChannel(TCL_STDIN);
- if (chan) {
- Tcl_CreateChannelHandler(chan, TCL_READABLE, StdinProc,
- (ClientData) chan);
+ isPtr->input = Tcl_GetStdChannel(TCL_STDIN);
+ if (isPtr->input) {
+ Tcl_CreateChannelHandler(isPtr->input, TCL_READABLE, StdinProc, isPtr);
}
- Tcl_DStringFree(&tsdPtr->command);
+ Tcl_DStringFree(&isPtr->command);
if (Tcl_GetStringResult(interp)[0] != '\0') {
- if ((code != TCL_OK) || (tsdPtr->tty)) {
- chan = Tcl_GetStdChannel(TCL_STDOUT);
+ if ((code != TCL_OK) || (isPtr->tty)) {
+ chan = Tcl_GetStdChannel((code != TCL_OK) ? TCL_STDERR : TCL_STDOUT);
if (chan) {
Tcl_WriteObj(chan, Tcl_GetObjResult(interp));
Tcl_WriteChars(chan, "\n", 1);
@@ -433,12 +459,12 @@ StdinProc(
}
/*
- * Output a prompt.
+ * If a tty stdin is still around, output a prompt.
*/
prompt:
- if (tsdPtr->tty) {
- Prompt(interp, gotPartial);
+ if (isPtr->tty && (isPtr->input != NULL)) {
+ Prompt(interp, isPtr);
}
Tcl_ResetResult(interp);
}
@@ -463,53 +489,42 @@ StdinProc(
static void
Prompt(
Tcl_Interp *interp, /* Interpreter to use for prompting. */
- int partial) /* Non-zero means there already exists a
- * partial command, so use the secondary
- * prompt. */
+ InteractiveState *isPtr) /* InteractiveState. */
{
- Tcl_Obj *promptCmd;
+ Tcl_Obj *promptCmdPtr;
int code;
- Tcl_Channel outChannel, errChannel;
+ Tcl_Channel chan;
- promptCmd = Tcl_GetVar2Ex(interp,
- partial ? "tcl_prompt2" : "tcl_prompt1", NULL, TCL_GLOBAL_ONLY);
- if (promptCmd == NULL) {
+ promptCmdPtr = Tcl_GetVar2Ex(interp,
+ isPtr->gotPartial ? "tcl_prompt2" : "tcl_prompt1", NULL, TCL_GLOBAL_ONLY);
+ if (promptCmdPtr == NULL) {
defaultPrompt:
- if (!partial) {
- /*
- * We must check that outChannel is a real channel - it is
- * possible that someone has transferred stdout out of this
- * interpreter with "interp transfer".
- */
-
- outChannel = Tcl_GetChannel(interp, "stdout", NULL);
- if (outChannel != (Tcl_Channel) NULL) {
- Tcl_WriteChars(outChannel, "% ", 2);
+ if (!isPtr->gotPartial) {
+ chan = Tcl_GetStdChannel(TCL_STDOUT);
+ if (chan != NULL) {
+ Tcl_WriteChars(chan, DEFAULT_PRIMARY_PROMPT,
+ strlen(DEFAULT_PRIMARY_PROMPT));
}
}
} else {
- code = Tcl_EvalObjEx(interp, promptCmd, TCL_EVAL_GLOBAL);
+ code = Tcl_EvalObjEx(interp, promptCmdPtr, TCL_EVAL_GLOBAL);
if (code != TCL_OK) {
Tcl_AddErrorInfo(interp,
"\n (script that generates prompt)");
-
- /*
- * We must check that errChannel is a real channel - it is
- * possible that someone has transferred stderr out of this
- * interpreter with "interp transfer".
- */
-
- errChannel = Tcl_GetChannel(interp, "stderr", NULL);
- if (errChannel != (Tcl_Channel) NULL) {
- Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
- Tcl_WriteChars(errChannel, "\n", 1);
+ if (Tcl_GetStringResult(interp)[0] != '\0') {
+ chan = Tcl_GetStdChannel(TCL_STDERR);
+ if (chan != NULL) {
+ Tcl_WriteObj(chan, Tcl_GetObjResult(interp));
+ Tcl_WriteChars(chan, "\n", 1);
+ }
}
goto defaultPrompt;
}
}
- outChannel = Tcl_GetChannel(interp, "stdout", NULL);
- if (outChannel != (Tcl_Channel) NULL) {
- Tcl_Flush(outChannel);
+
+ chan = Tcl_GetStdChannel(TCL_STDOUT);
+ if (chan != NULL) {
+ Tcl_Flush(chan);
}
}
generated by cgit v0.12 at 2024-11-26 13:05:47 (GMT)