upgrade to tcl/tk 8.6.8

1 files changed, 549 insertions, 0 deletions

diff --git a/tk8.6/generic/tkMain.c b/tk8.6/generic/tkMain.c
new file mode 100644
index 0000000..1b21223
--- /dev/null
+++ b/tk8.6/generic/tkMain.c
@@ -0,0 +1,549 @@
+/*
+ * 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:
+ */