--- projs/trunk/shared_source/c_tk_base_7_5_w_mods/tkmain.c 2016/11/05 10:55:22 70 +++ projs/trunk/shared_source/c_tk_base_7_5_w_mods/tkmain.c 2016/11/05 11:07:06 71 @@ -1,525 +1,525 @@ -/* $Header$ */ - -/* - * tkMain.c -- - * - * This file contains a generic main program for Tk-based applications. - * It can be used as-is for many applications, just by supplying a - * different appInitProc procedure for each specific application. - * Or, it can be used as a template for creating new main programs - * for Tk applications. - * - * Copyright (c) 1990-1994 The Regents of the University of California. - * Copyright (c) 1994-1997 Sun Microsystems, Inc. - * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. - * - * RCS: @(#) $Id: tkmain.c,v 1.1.1.1 2001/06/13 05:05:07 dtashley Exp $ - */ - -#define MODULE_TK_MAIN - -#include -#include -#include -#include -#include - -#include "appinit.h" -#include "build_config.h" -#include "extninit.h" -#include "msgstrs.h" - -#include "tk.h" -#include "tkInt.h" -#ifdef NO_STDLIB_H -# include "../compat/stdlib.h" -#else -# include -#endif -#ifdef __WIN32__ -#include "tkWinInt.h" -#endif - - -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; -Tcl_ThreadDataKey dataKey; - -/* - * Declarations for various library procedures and variables (don't want - * to include tkInt.h or tkPort.h here, because people might copy this - * file out of the Tk source directory to make their own modified versions). - * Note: don't declare "exit" here even though a declaration is really - * needed, because it will conflict with a declaration elsewhere on - * some systems. - */ - -#if !defined(__WIN32__) && !defined(_WIN32) -extern int isatty _ANSI_ARGS_((int fd)); -extern char * strrchr _ANSI_ARGS_((CONST char *string, int c)); -#endif -extern void TkpDisplayWarning _ANSI_ARGS_((char *msg, - char *title)); - -/* - * Forward declarations for procedures defined later in this file. - */ - -static void Prompt _ANSI_ARGS_((Tcl_Interp *interp, int partial)); -static void StdinProc _ANSI_ARGS_((ClientData clientData, - int mask)); - -/* - *---------------------------------------------------------------------- - * - * Tk_MainEx -- - * - * Main program for Wish and most other Tk-based applications. - * - * Results: - * None. This procedure never returns (it exits the process when - * it's done. - * - * Side effects: - * This procedure initializes the Tk world and then starts - * interpreting commands; almost anything could happen, depending - * on the script being interpreted. - * - *---------------------------------------------------------------------- - */ -void -Tk_MainEx(argc, argv, appInitProc, interp) - int argc; /* Number of arguments. */ - char **argv; /* Array of argument strings. */ - Tcl_AppInitProc *appInitProc; /* Application-specific initialization - * procedure to call after most - * initialization but before starting - * to execute commands. This input - * parameter is ignored because of the - * integration of the code automatically - * generated by "mktclapp". - */ - Tcl_Interp *interp; -{ - char *args, *fileName; - char buf[TCL_INTEGER_SPACE]; - int code; - size_t length; - Tcl_Channel inChannel, outChannel; - Tcl_DString argString; - ThreadSpecificData *tsdPtr; -#ifdef __WIN32__ - HANDLE handle; -#endif -#if 1 - /* Dope the environment variables so that the first place the - ** run-time code searches for the library files is in the "baked in" - ** libraries. Over time, this should be changed to permanently - ** bake things in so that this trick isn't necessary. - */ - putenv("TCL_LIBRARY=" ET_TCL_LIBRARY); - putenv("TK_LIBRARY=" ET_TK_LIBRARY); - - /* Run the local initialization procedure for the ET module. - ** This will dope the interpreter so that attempts to load the - ** library files will get redirected internally. - */ - - Et_DoInit(interp); -#endif - -/* appInitProc = Et_DoInit; */ - - /* - * Ensure that we are getting the matching version of Tcl. This is - * really only an issue when Tk is loaded dynamically. - */ - - if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) { - abort(); - } - - tsdPtr = (ThreadSpecificData *) - Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); - - Tcl_FindExecutable(argv[0]); - tsdPtr->interp = interp; - -#if (defined(__WIN32__) || defined(MAC_TCL)) - Tk_InitConsoleChannels(interp); -#endif - -#ifdef TCL_MEM_DEBUG - Tcl_InitMemory(interp); -#endif - - /* - * Parse command-line arguments. A leading "-file" argument is - * ignored (a historical relic from the distant past). If the - * next argument doesn't start with a "-" then strip it off and - * use it as the name of a script file to process. - */ - - fileName = TclGetStartupScriptFileName(); - - if (argc > 1) { - length = strlen(argv[1]); - if ((length >= 2) && (strncmp(argv[1], "-file", length) == 0)) { - argc--; - argv++; - } - } - if (fileName == NULL) { - if ((argc > 1) && (argv[1][0] != '-')) { - fileName = argv[1]; - argc--; - argv++; - } - } - - /* - * Make command-line arguments available in the Tcl variables "argc" - * and "argv". - */ - - args = Tcl_Merge(argc-1, argv+1); - Tcl_ExternalToUtfDString(NULL, args, -1, &argString); - Tcl_SetVar(interp, "argv", Tcl_DStringValue(&argString), TCL_GLOBAL_ONLY); - Tcl_DStringFree(&argString); - ckfree(args); - sprintf(buf, "%d", argc-1); - - if (fileName == NULL) { - Tcl_ExternalToUtfDString(NULL, argv[0], -1, &argString); - } else { - fileName = Tcl_ExternalToUtfDString(NULL, fileName, -1, &argString); - } - Tcl_SetVar(interp, "argc", buf, TCL_GLOBAL_ONLY); - Tcl_SetVar(interp, "argv0", Tcl_DStringValue(&argString), TCL_GLOBAL_ONLY); - - /* - * Set the "tcl_interactive" variable. - */ - - /* - * 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. - */ - -#ifdef __WIN32__ - 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 - Tcl_SetVar(interp, "tcl_interactive", - ((fileName == NULL) && tsdPtr->tty) ? "1" : "0", TCL_GLOBAL_ONLY); - - /* - * Invoke application-specific initialization. - */ - - if ((*appInitProc)(interp) != TCL_OK) { - TkpDisplayWarning(Tcl_GetStringResult(interp), - "Application initialization failed"); - } - - /* Register any extensions that should be registered for the - ** executable currently being built. - */ - ExtninitInit(interp); - - /* Set a Tcl variable to indicate the particular product - ** we are building. This is used in the startup message script - ** to announce product version, and may be used other - ** places, as well. - */ - Tcl_SetVar(interp, - BUILD_CONFIG_PRODUCT_NAME_VARIABLE, - BUILD_CONFIG_STATIC_WISH_ALIAS, - TCL_GLOBAL_ONLY); - - /* Set Tcl variable to indicate the relese version of the - ** product we are building. This is used in the startup message script - ** to announce product version, and may be used other - ** places, as well. - */ - Tcl_SetVar(interp, - BUILD_CONFIG_PRODUCT_VERSION_VARIABLE, - BUILD_CONFIG_RELEASE_VERSION, - TCL_GLOBAL_ONLY); - - /* Change the title of the console window to reflect - ** the product name and version. - */ - Tcl_GlobalEval(interp, - "wm title . \"" - BUILD_CONFIG_STATIC_WISH_ALIAS - " v" - BUILD_CONFIG_RELEASE_VERSION - "\""); - - /* Output the introductory message to the console. - ** The script called is generic and applies to both - ** IjuScripter and IjuConsole. - */ - Tcl_GlobalEval(interp, BUILD_CONFIG_StartupMessageScript); - - /* - * Invoke the script specified on the command line, if any. - */ - - if (fileName != NULL) { - Tcl_ResetResult(interp); - code = Tcl_EvalFile(interp, fileName); - 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, - (ClientData) inChannel); - } - if (tsdPtr->tty) { - Prompt(interp, 0); - } - } - Tcl_DStringFree(&argString); - - 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_Exit(0); -} - -/* - *---------------------------------------------------------------------- - * - * StdinProc -- - * - * 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. - * - *---------------------------------------------------------------------- - */ - - /* ARGSUSED */ -static void -StdinProc(clientData, mask) - ClientData clientData; /* Not used. */ - 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; - - count = Tcl_Gets(chan, &tsdPtr->line); - - if (count < 0) { - if (!gotPartial) { - if (tsdPtr->tty) { - Tcl_Exit(0); - } else { - Tcl_DeleteChannelHandler(chan, StdinProc, (ClientData) chan); - } - return; - } - } - - (void) Tcl_DStringAppend(&tsdPtr->command, Tcl_DStringValue( - &tsdPtr->line), -1); - cmd = Tcl_DStringAppend(&tsdPtr->command, "\n", -1); - Tcl_DStringFree(&tsdPtr->line); - if (!Tcl_CommandComplete(cmd)) { - gotPartial = 1; - goto prompt; - } - gotPartial = 0; - - /* - * 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. - */ - - Tcl_CreateChannelHandler(chan, 0, StdinProc, (ClientData) chan); - code = Tcl_RecordAndEval(interp, cmd, TCL_EVAL_GLOBAL); - - chan = Tcl_GetStdChannel(TCL_STDIN); - if (chan) { - Tcl_CreateChannelHandler(chan, TCL_READABLE, StdinProc, - (ClientData) chan); - } - Tcl_DStringFree(&tsdPtr->command); - if (Tcl_GetStringResult(interp)[0] != '\0') { - if ((code != TCL_OK) || (tsdPtr->tty)) { - chan = Tcl_GetStdChannel(TCL_STDOUT); - if (chan) { - Tcl_WriteObj(chan, Tcl_GetObjResult(interp)); - Tcl_WriteChars(chan, "\n", 1); - } - } - } - - /* - * Output a prompt. - */ - - prompt: - if (tsdPtr->tty) { - Prompt(interp, gotPartial); - } - Tcl_ResetResult(interp); -} - -/* - *---------------------------------------------------------------------- - * - * 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. - * - *---------------------------------------------------------------------- - */ - -static void -Prompt(interp, partial) - Tcl_Interp *interp; /* Interpreter to use for prompting. */ - int partial; /* Non-zero means there already - * exists a partial command, so use - * the secondary prompt. */ -{ - char *promptCmd; - int code; - Tcl_Channel outChannel, errChannel; - - promptCmd = Tcl_GetVar(interp, - partial ? "tcl_prompt2" : "tcl_prompt1", TCL_GLOBAL_ONLY); - if (promptCmd == 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); - } - } - } else { - code = Tcl_Eval(interp, promptCmd); - 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); - } - goto defaultPrompt; - } - } - outChannel = Tcl_GetChannel(interp, "stdout", NULL); - if (outChannel != (Tcl_Channel) NULL) { - Tcl_Flush(outChannel); - } -} - -/* End of tkmain.c */ +/* $Header$ */ + +/* + * tkMain.c -- + * + * This file contains a generic main program for Tk-based applications. + * It can be used as-is for many applications, just by supplying a + * different appInitProc procedure for each specific application. + * Or, it can be used as a template for creating new main programs + * for Tk applications. + * + * Copyright (c) 1990-1994 The Regents of the University of California. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * RCS: @(#) $Id: tkmain.c,v 1.1.1.1 2001/06/13 05:05:07 dtashley Exp $ + */ + +#define MODULE_TK_MAIN + +#include +#include +#include +#include +#include + +#include "appinit.h" +#include "build_config.h" +#include "extninit.h" +#include "msgstrs.h" + +#include "tk.h" +#include "tkInt.h" +#ifdef NO_STDLIB_H +# include "../compat/stdlib.h" +#else +# include +#endif +#ifdef __WIN32__ +#include "tkWinInt.h" +#endif + + +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; +Tcl_ThreadDataKey dataKey; + +/* + * Declarations for various library procedures and variables (don't want + * to include tkInt.h or tkPort.h here, because people might copy this + * file out of the Tk source directory to make their own modified versions). + * Note: don't declare "exit" here even though a declaration is really + * needed, because it will conflict with a declaration elsewhere on + * some systems. + */ + +#if !defined(__WIN32__) && !defined(_WIN32) +extern int isatty _ANSI_ARGS_((int fd)); +extern char * strrchr _ANSI_ARGS_((CONST char *string, int c)); +#endif +extern void TkpDisplayWarning _ANSI_ARGS_((char *msg, + char *title)); + +/* + * Forward declarations for procedures defined later in this file. + */ + +static void Prompt _ANSI_ARGS_((Tcl_Interp *interp, int partial)); +static void StdinProc _ANSI_ARGS_((ClientData clientData, + int mask)); + +/* + *---------------------------------------------------------------------- + * + * Tk_MainEx -- + * + * Main program for Wish and most other Tk-based applications. + * + * Results: + * None. This procedure never returns (it exits the process when + * it's done. + * + * Side effects: + * This procedure initializes the Tk world and then starts + * interpreting commands; almost anything could happen, depending + * on the script being interpreted. + * + *---------------------------------------------------------------------- + */ +void +Tk_MainEx(argc, argv, appInitProc, interp) + int argc; /* Number of arguments. */ + char **argv; /* Array of argument strings. */ + Tcl_AppInitProc *appInitProc; /* Application-specific initialization + * procedure to call after most + * initialization but before starting + * to execute commands. This input + * parameter is ignored because of the + * integration of the code automatically + * generated by "mktclapp". + */ + Tcl_Interp *interp; +{ + char *args, *fileName; + char buf[TCL_INTEGER_SPACE]; + int code; + size_t length; + Tcl_Channel inChannel, outChannel; + Tcl_DString argString; + ThreadSpecificData *tsdPtr; +#ifdef __WIN32__ + HANDLE handle; +#endif +#if 1 + /* Dope the environment variables so that the first place the + ** run-time code searches for the library files is in the "baked in" + ** libraries. Over time, this should be changed to permanently + ** bake things in so that this trick isn't necessary. + */ + putenv("TCL_LIBRARY=" ET_TCL_LIBRARY); + putenv("TK_LIBRARY=" ET_TK_LIBRARY); + + /* Run the local initialization procedure for the ET module. + ** This will dope the interpreter so that attempts to load the + ** library files will get redirected internally. + */ + + Et_DoInit(interp); +#endif + +/* appInitProc = Et_DoInit; */ + + /* + * Ensure that we are getting the matching version of Tcl. This is + * really only an issue when Tk is loaded dynamically. + */ + + if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) { + abort(); + } + + tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + + Tcl_FindExecutable(argv[0]); + tsdPtr->interp = interp; + +#if (defined(__WIN32__) || defined(MAC_TCL)) + Tk_InitConsoleChannels(interp); +#endif + +#ifdef TCL_MEM_DEBUG + Tcl_InitMemory(interp); +#endif + + /* + * Parse command-line arguments. A leading "-file" argument is + * ignored (a historical relic from the distant past). If the + * next argument doesn't start with a "-" then strip it off and + * use it as the name of a script file to process. + */ + + fileName = TclGetStartupScriptFileName(); + + if (argc > 1) { + length = strlen(argv[1]); + if ((length >= 2) && (strncmp(argv[1], "-file", length) == 0)) { + argc--; + argv++; + } + } + if (fileName == NULL) { + if ((argc > 1) && (argv[1][0] != '-')) { + fileName = argv[1]; + argc--; + argv++; + } + } + + /* + * Make command-line arguments available in the Tcl variables "argc" + * and "argv". + */ + + args = Tcl_Merge(argc-1, argv+1); + Tcl_ExternalToUtfDString(NULL, args, -1, &argString); + Tcl_SetVar(interp, "argv", Tcl_DStringValue(&argString), TCL_GLOBAL_ONLY); + Tcl_DStringFree(&argString); + ckfree(args); + sprintf(buf, "%d", argc-1); + + if (fileName == NULL) { + Tcl_ExternalToUtfDString(NULL, argv[0], -1, &argString); + } else { + fileName = Tcl_ExternalToUtfDString(NULL, fileName, -1, &argString); + } + Tcl_SetVar(interp, "argc", buf, TCL_GLOBAL_ONLY); + Tcl_SetVar(interp, "argv0", Tcl_DStringValue(&argString), TCL_GLOBAL_ONLY); + + /* + * Set the "tcl_interactive" variable. + */ + + /* + * 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. + */ + +#ifdef __WIN32__ + 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 + Tcl_SetVar(interp, "tcl_interactive", + ((fileName == NULL) && tsdPtr->tty) ? "1" : "0", TCL_GLOBAL_ONLY); + + /* + * Invoke application-specific initialization. + */ + + if ((*appInitProc)(interp) != TCL_OK) { + TkpDisplayWarning(Tcl_GetStringResult(interp), + "Application initialization failed"); + } + + /* Register any extensions that should be registered for the + ** executable currently being built. + */ + ExtninitInit(interp); + + /* Set a Tcl variable to indicate the particular product + ** we are building. This is used in the startup message script + ** to announce product version, and may be used other + ** places, as well. + */ + Tcl_SetVar(interp, + BUILD_CONFIG_PRODUCT_NAME_VARIABLE, + BUILD_CONFIG_STATIC_WISH_ALIAS, + TCL_GLOBAL_ONLY); + + /* Set Tcl variable to indicate the relese version of the + ** product we are building. This is used in the startup message script + ** to announce product version, and may be used other + ** places, as well. + */ + Tcl_SetVar(interp, + BUILD_CONFIG_PRODUCT_VERSION_VARIABLE, + BUILD_CONFIG_RELEASE_VERSION, + TCL_GLOBAL_ONLY); + + /* Change the title of the console window to reflect + ** the product name and version. + */ + Tcl_GlobalEval(interp, + "wm title . \"" + BUILD_CONFIG_STATIC_WISH_ALIAS + " v" + BUILD_CONFIG_RELEASE_VERSION + "\""); + + /* Output the introductory message to the console. + ** The script called is generic and applies to both + ** IjuScripter and IjuConsole. + */ + Tcl_GlobalEval(interp, BUILD_CONFIG_StartupMessageScript); + + /* + * Invoke the script specified on the command line, if any. + */ + + if (fileName != NULL) { + Tcl_ResetResult(interp); + code = Tcl_EvalFile(interp, fileName); + 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, + (ClientData) inChannel); + } + if (tsdPtr->tty) { + Prompt(interp, 0); + } + } + Tcl_DStringFree(&argString); + + 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_Exit(0); +} + +/* + *---------------------------------------------------------------------- + * + * StdinProc -- + * + * 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. + * + *---------------------------------------------------------------------- + */ + + /* ARGSUSED */ +static void +StdinProc(clientData, mask) + ClientData clientData; /* Not used. */ + 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; + + count = Tcl_Gets(chan, &tsdPtr->line); + + if (count < 0) { + if (!gotPartial) { + if (tsdPtr->tty) { + Tcl_Exit(0); + } else { + Tcl_DeleteChannelHandler(chan, StdinProc, (ClientData) chan); + } + return; + } + } + + (void) Tcl_DStringAppend(&tsdPtr->command, Tcl_DStringValue( + &tsdPtr->line), -1); + cmd = Tcl_DStringAppend(&tsdPtr->command, "\n", -1); + Tcl_DStringFree(&tsdPtr->line); + if (!Tcl_CommandComplete(cmd)) { + gotPartial = 1; + goto prompt; + } + gotPartial = 0; + + /* + * 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. + */ + + Tcl_CreateChannelHandler(chan, 0, StdinProc, (ClientData) chan); + code = Tcl_RecordAndEval(interp, cmd, TCL_EVAL_GLOBAL); + + chan = Tcl_GetStdChannel(TCL_STDIN); + if (chan) { + Tcl_CreateChannelHandler(chan, TCL_READABLE, StdinProc, + (ClientData) chan); + } + Tcl_DStringFree(&tsdPtr->command); + if (Tcl_GetStringResult(interp)[0] != '\0') { + if ((code != TCL_OK) || (tsdPtr->tty)) { + chan = Tcl_GetStdChannel(TCL_STDOUT); + if (chan) { + Tcl_WriteObj(chan, Tcl_GetObjResult(interp)); + Tcl_WriteChars(chan, "\n", 1); + } + } + } + + /* + * Output a prompt. + */ + + prompt: + if (tsdPtr->tty) { + Prompt(interp, gotPartial); + } + Tcl_ResetResult(interp); +} + +/* + *---------------------------------------------------------------------- + * + * 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. + * + *---------------------------------------------------------------------- + */ + +static void +Prompt(interp, partial) + Tcl_Interp *interp; /* Interpreter to use for prompting. */ + int partial; /* Non-zero means there already + * exists a partial command, so use + * the secondary prompt. */ +{ + char *promptCmd; + int code; + Tcl_Channel outChannel, errChannel; + + promptCmd = Tcl_GetVar(interp, + partial ? "tcl_prompt2" : "tcl_prompt1", TCL_GLOBAL_ONLY); + if (promptCmd == 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); + } + } + } else { + code = Tcl_Eval(interp, promptCmd); + 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); + } + goto defaultPrompt; + } + } + outChannel = Tcl_GetChannel(interp, "stdout", NULL); + if (outChannel != (Tcl_Channel) NULL) { + Tcl_Flush(outChannel); + } +} + +/* End of tkmain.c */