void
Tk_MainEx(
int argc, /* Number of arguments. */
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, *appName;
const char *encodingName;
int code, nullStdin = 0;
Tcl_Channel chan;
InteractiveState is;
/*
* 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, TCL_VERSION, 0) == NULL) {
abort();
}
#if defined(__WIN32__) && !defined(__WIN64__) && !defined(UNICODE) && !defined(STATIC_BUILD)
if (tclStubsPtr->reserved9) {
/* We are running win32 Tk under Cygwin, so let's check
* whether the env("DISPLAY") variable or the -display
* argument is set. If so, we really want to run the
* Tk_MainEx function of libtk8.?.dll, not this one. */
if (Tcl_GetVar2(interp, "env", "DISPLAY", TCL_GLOBAL_ONLY)) {
loadCygwinTk:
if (TkCygwinMainEx(argc, argv, appInitProc, interp)) {
/* Should never reach here. */
return;
}
} else {
int i;
for (i = 1; i < argc; ++i) {
if (!_tcscmp(argv[i], TEXT("-display"))) {
goto loadCygwinTk;
}
}
}
}
#endif
Tcl_InitMemory(interp);
is.interp = interp;
is.gotPartial = 0;
Tcl_Preserve(interp);
#if defined(__WIN32__) && !defined(__CYGWIN__)
Tk_InitConsoleChannels(interp);
#endif
#ifdef MAC_OSX_TK
if (Tcl_GetStartupScript(NULL) == NULL) {
TkMacOSXDefaultStartupScript();
}
#endif
/*
* If the application has not already set a startup script, parse the
* first few command line arguments to determine the script path and
* encoding.
*/
if (NULL == Tcl_GetStartupScript(NULL)) {
size_t length;
/*
* Check whether first 3 args (argv[1] - argv[3]) look like
* -encoding ENCODING FILENAME
* or like
* FILENAME
* or like
* -file FILENAME (ancient history support only)
*/
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) && (TEXT('-') != argv[1][0])) {
Tcl_SetStartupScript(NewNativeObj(argv[1], -1), NULL);
argc--;
argv++;
} 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 (path == NULL) {
appName = NewNativeObj(argv[0], -1);
} else {
appName = path;
}
Tcl_SetVar2Ex(interp, "argv0", NULL, appName, TCL_GLOBAL_ONLY);
argc--;
argv++;
Tcl_SetVar2Ex(interp, "argc", NULL, Tcl_NewIntObj(argc), TCL_GLOBAL_ONLY);
argvPtr = Tcl_NewListObj(0, NULL);
while (argc--) {
Tcl_ListObjAppendElement(NULL, argvPtr, NewNativeObj(*argv++, -1));
}
Tcl_SetVar2Ex(interp, "argv", NULL, argvPtr, TCL_GLOBAL_ONLY);
/*
* Set the "tcl_interactive" variable.
*/
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 (!is.tty) {
struct stat st;
nullStdin = fstat(0, &st) || (S_ISCHR(st.st_mode) && !st.st_blocks);
}
#endif
Tcl_SetVar2Ex(interp, "tcl_interactive", NULL,
Tcl_NewIntObj(!path && (is.tty || nullStdin)), TCL_GLOBAL_ONLY);
/*
* Invoke application-specific initialization.
*/
if (appInitProc(interp) != TCL_OK) {
TkpDisplayWarning(Tcl_GetStringResult(interp),
"application-specific initialization failed");
}
/*
* 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) {
/*
* The following statement guarantees that the errorInfo variable
* is set properly.
*/
Tcl_AddErrorInfo(interp, "");
TkpDisplayWarning(Tcl_GetVar(interp, "errorInfo",
TCL_GLOBAL_ONLY), "Error in startup script");
Tcl_DeleteInterp(interp);
Tcl_Exit(1);
}
is.tty = 0;
} else {
/*
* Evaluate the .rc file, if one has been specified.
*/
Tcl_SourceRCFile(interp);
/*
* Establish a channel handler for stdin.
*/
is.input = Tcl_GetStdChannel(TCL_STDIN);
if (is.input) {
Tcl_CreateChannelHandler(is.input, TCL_READABLE, StdinProc, &is);
}
if (is.tty) {
Prompt(interp, &is);
}
}
chan = Tcl_GetStdChannel(TCL_STDOUT);
if (chan) {
Tcl_Flush(chan);
}
Tcl_DStringInit(&is.command);
Tcl_DStringInit(&is.line);
Tcl_ResetResult(interp);
/*
* Loop infinitely, waiting for commands to execute. When there are no
* windows left, Tk_MainLoop returns and we exit.
*/
Tk_MainLoop();
Tcl_DeleteInterp(interp);
Tcl_Release(interp);
Tcl_SetStartupScript(NULL, NULL);
Tcl_Exit(0);
}
void
Tk_MainEx(
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_Interp *interp)
{
Tcl_Obj *path, *argvPtr;
const char *encodingName;
int code, nullStdin = 0;
Tcl_Channel inChannel, outChannel;
ThreadSpecificData *tsdPtr;
#ifdef __WIN32__
HANDLE handle;
#endif
Tcl_DString appName;
/*
* 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, TCL_VERSION, 0) == NULL) {
abort();
}
tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
Tcl_FindExecutable(argv[0]);
tsdPtr->interp = interp;
Tcl_Preserve(interp);
#if defined(__WIN32__)
Tk_InitConsoleChannels(interp);
#endif
#ifdef MAC_OSX_TK
if (Tcl_GetStartupScript(NULL) == NULL) {
TkMacOSXDefaultStartupScript();
}
#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
* encoding.
*/
if (NULL == Tcl_GetStartupScript(NULL)) {
size_t length;
/*
* Check whether first 3 args (argv[1] - argv[3]) look like
* -encoding ENCODING FILENAME
* or like
* FILENAME
* or like
* -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]);
argc -= 3;
argv += 3;
} else if ((argc > 1) && ('-' != argv[1][0])) {
Tcl_SetStartupScript(Tcl_NewStringObj(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);
argc -= 2;
argv += 2;
}
}
path = Tcl_GetStartupScript(&encodingName);
if (NULL == path) {
Tcl_ExternalToUtfDString(NULL, argv[0], -1, &appName);
} 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);
}
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);
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_SetVar2Ex(interp, "argv", NULL, argvPtr, TCL_GLOBAL_ONLY);
/*
* Set the "tcl_interactive" variable.
*/
#ifdef __WIN32__
/*
* 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.
*/
handle = GetStdHandle(STD_INPUT_HANDLE);
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.
*/
tsdPtr->tty = 1;
} else if (GetFileType(handle) == FILE_TYPE_CHAR) {
/*
* A character file handle is a tty by definition.
*/
tsdPtr->tty = 1;
} else {
tsdPtr->tty = 0;
}
#else
tsdPtr->tty = isatty(0);
#endif
#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) {
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);
/*
* Invoke application-specific initialization.
*/
if (appInitProc(interp) != TCL_OK) {
TkpDisplayWarning(Tcl_GetStringResult(interp),
"Application initialization failed");
}
/*
* 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) {
/*
* The following statement guarantees that the errorInfo variable
* is set properly.
*/
Tcl_AddErrorInfo(interp, "");
TkpDisplayWarning(Tcl_GetVar(interp, "errorInfo",
TCL_GLOBAL_ONLY), "Error in startup script");
Tcl_DeleteInterp(interp);
Tcl_Exit(1);
}
tsdPtr->tty = 0;
} else {
/*
* Evaluate the .rc file, if one has been specified.
*/
Tcl_SourceRCFile(interp);
/*
* Establish a channel handler for stdin.
*/
inChannel = Tcl_GetStdChannel(TCL_STDIN);
if (inChannel) {
Tcl_CreateChannelHandler(inChannel, TCL_READABLE, StdinProc,
inChannel);
}
if (tsdPtr->tty) {
Prompt(interp, 0);
}
}
outChannel = Tcl_GetStdChannel(TCL_STDOUT);
if (outChannel) {
Tcl_Flush(outChannel);
}
Tcl_DStringInit(&tsdPtr->command);
Tcl_DStringInit(&tsdPtr->line);
Tcl_ResetResult(interp);
/*
* Loop infinitely, waiting for commands to execute. When there are no
* windows left, Tk_MainLoop returns and we exit.
*/
Tk_MainLoop();
Tcl_DeleteInterp(interp);
Tcl_Release(interp);
Tcl_SetStartupScript(NULL, NULL);
Tcl_Exit(0);
}
