diff options
Diffstat (limited to 'tk8.6/generic/tkMain.c')
| -rw-r--r-- | tk8.6/generic/tkMain.c | 549 |
1 files changed, 0 insertions, 549 deletions
diff --git a/tk8.6/generic/tkMain.c b/tk8.6/generic/tkMain.c deleted file mode 100644 index 1b21223..0000000 --- a/tk8.6/generic/tkMain.c +++ /dev/null @@ -1,549 +0,0 @@ -/* - * 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 "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 -/* Little hack to eliminate the need for "tclInt.h" here: - Just copy a small portion of TclIntPlatStubs, just - enough to make it work. See [600b72bfbc] */ -typedef struct { - int magic; - void *hooks; - void (*dummy[16]) (void); /* dummy entries 0-15, not used */ - int (*tclpIsAtty) (int fd); /* 16 */ -} TclIntPlatStubs; -extern const TclIntPlatStubs *tclIntPlatStubsPtr; -# 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. - */ - -#if !defined(STATIC_BUILD) - if (tclStubsPtr->reserved9 && tclIntPlatStubsPtr->tclpIsAtty) { - /* We are running on Cygwin */ - return tclIntPlatStubsPtr->tclpIsAtty(fd); - } -#endif - 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. - */ - - if (Tcl_InitStubs(interp, "8.6", 0) == NULL) { - if (Tcl_InitStubs(interp, "8.1", 0) == NULL) { - abort(); - } else { - Tcl_Panic("%s", Tcl_GetString(Tcl_GetObjResult(interp))); - } - } - -#if defined(_WIN32) && !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_GetString(Tcl_GetObjResult(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_GetVar2(interp, "errorInfo", NULL, - 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_GetString(Tcl_GetObjResult(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_GetString(Tcl_GetObjResult(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: - */ |