/* * 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 function 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. */ /** * 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 #include #include #include "tkInt.h" #ifdef NO_STDLIB_H # include "../compat/stdlib.h" #else # include #endif /* * 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 we have to translate that * to strcmp here. */ #ifdef __WIN32__ # 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 /* * 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 * 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: do * not declare "exit" here even though a declaration is really needed, because * it will conflict with a declaration elsewhere on some systems. */ #if defined(_WIN32) #define isatty WinIsTty static int WinIsTty(int fd) { HANDLE handle; /* * 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 + fd); /* * 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 (handle == INVALID_HANDLE_VALUE) || (handle == 0) || (GetFileType(handle) == FILE_TYPE_UNKNOWN) || (GetFileType(handle) == FILE_TYPE_CHAR); } #else extern int isatty(int fd); #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, InteractiveState *isPtr); static void StdinProc(ClientData clientData, int mask); /* *---------------------------------------------------------------------- * * Tk_MainEx -- * * Main program for Wish and most other Tk-based applications. * * Results: * None. This function never returns (it exits the process when it's * done). * * Side effects: * This function initializes the Tk world and then starts interpreting * commands; almost anything could happen, depending on the script being * interpreted. * *---------------------------------------------------------------------- */ 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(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 libtk.dll, not this one. */ if (Tcl_GetVar2(interp, "env", "DISPLAY", TCL_GLOBAL_ONLY)) { loadCygwinTk: Tcl_Panic("Should load libtk.dll now, not yet implemented"); } 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); } /* *---------------------------------------------------------------------- * * StdinProc -- * * This function 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 clientData, /* The state of interactive cmd line */ int mask) /* Not used. */ { char *cmd; int code, count; InteractiveState *isPtr = clientData; Tcl_Channel chan = isPtr->input; Tcl_Interp *interp = isPtr->interp; count = Tcl_Gets(chan, &isPtr->line); if (count < 0 && !isPtr->gotPartial) { if (isPtr->tty) { Tcl_Exit(0); } else { Tcl_DeleteChannelHandler(chan, StdinProc, isPtr); } return; } Tcl_DStringAppend(&isPtr->command, Tcl_DStringValue(&isPtr->line), -1); cmd = Tcl_DStringAppend(&isPtr->command, "\n", -1); Tcl_DStringFree(&isPtr->line); if (!Tcl_CommandComplete(cmd)) { isPtr->gotPartial = 1; goto prompt; } isPtr->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, isPtr); code = Tcl_RecordAndEval(interp, cmd, TCL_EVAL_GLOBAL); isPtr->input = Tcl_GetStdChannel(TCL_STDIN); if (isPtr->input) { Tcl_CreateChannelHandler(isPtr->input, TCL_READABLE, StdinProc, isPtr); } Tcl_DStringFree(&isPtr->command); if (Tcl_GetStringResult(interp)[0] != '\0') { 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); } } } /* * If a tty stdin is still around, output a prompt. */ prompt: if (isPtr->tty && (isPtr->input != NULL)) { Prompt(interp, isPtr); } 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( Tcl_Interp *interp, /* Interpreter to use for prompting. */ InteractiveState *isPtr) /* InteractiveState. */ { Tcl_Obj *promptCmdPtr; int code; Tcl_Channel chan; promptCmdPtr = Tcl_GetVar2Ex(interp, isPtr->gotPartial ? "tcl_prompt2" : "tcl_prompt1", NULL, TCL_GLOBAL_ONLY); if (promptCmdPtr == NULL) { defaultPrompt: 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, promptCmdPtr, TCL_EVAL_GLOBAL); if (code != TCL_OK) { Tcl_AddErrorInfo(interp, "\n (script that generates prompt)"); 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; } } chan = Tcl_GetStdChannel(TCL_STDOUT); if (chan != NULL) { Tcl_Flush(chan); } } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */