summaryrefslogtreecommitdiffstats
path: root/generic/tkMain.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tkMain.c')
-rw-r--r--generic/tkMain.c295
1 files changed, 152 insertions, 143 deletions
diff --git a/generic/tkMain.c b/generic/tkMain.c
index 5e5ddb7..4d348ef 100644
--- a/generic/tkMain.c
+++ b/generic/tkMain.c
@@ -3,29 +3,19 @@
*
* 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.
+ * 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.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
-#include <ctype.h>
-#include <stdio.h>
-#include <string.h>
-#include <tcl.h>
-#include <tclInt.h>
-#include <tk.h>
+#include "tclInt.h"
#include "tkInt.h"
-#ifdef NO_STDLIB_H
-# include "../compat/stdlib.h"
-#else
-# include <stdlib.h>
-#endif
#ifdef __WIN32__
#include "tkWinInt.h"
#include "../win/tclWinPort.h"
@@ -37,24 +27,23 @@
extern int TkCygwinMainEx(int, char **, Tcl_AppInitProc *, Tcl_Interp *);
typedef struct ThreadSpecificData {
- Tcl_Interp *interp; /* Interpreter for this thread. */
- Tcl_DString command; /* Used to assemble lines of terminal input
+ 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
+ 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. */
+ int tty; /* Non-zero means standard input is a
+ * terminal-like device. Zero means it's a
+ * file. */
} ThreadSpecificData;
static 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.
+ * 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__) || defined(_WIN32)
@@ -96,17 +85,16 @@ static int WinIsTty(int fd) {
}
}
#else
-extern int isatty _ANSI_ARGS_((int fd));
-extern char * strrchr _ANSI_ARGS_((CONST char *string, int c));
+extern int isatty(int fd);
+extern char * strrchr(CONST char *string, int c);
#endif
/*
- * Forward declarations for procedures defined later in this file.
+ * Forward declarations for functions defined later in this file.
*/
-static void Prompt _ANSI_ARGS_((Tcl_Interp *interp, int partial));
-static void StdinProc _ANSI_ARGS_((ClientData clientData,
- int mask));
+static void Prompt(Tcl_Interp *interp, int partial);
+static void StdinProc(ClientData clientData, int mask);
/*
*----------------------------------------------------------------------
@@ -116,39 +104,39 @@ static void StdinProc _ANSI_ARGS_((ClientData clientData,
* Main program for Wish and most other Tk-based applications.
*
* Results:
- * None. This procedure never returns (it exits the process when
- * it's done.
+ * None. This function 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.
+ * This function 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. */
- Tcl_Interp *interp;
+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 *argvPtr;
+ Tcl_Obj *path, *argvPtr;
+ CONST char *encodingName;
int code, nullStdin = 0;
- size_t length;
Tcl_Channel inChannel, outChannel;
- Tcl_DString appName;
ThreadSpecificData *tsdPtr;
+ Tcl_DString appName;
/*
- * Ensure that we are getting the matching version of Tcl. This is
- * really only an issue when Tk is loaded dynamically.
+ * 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) {
+ if (Tcl_InitStubs(interp, "8.5.0", 0) == NULL) {
abort();
}
@@ -178,7 +166,7 @@ Tk_MainEx(argc, argv, appInitProc, interp)
#endif
tsdPtr = (ThreadSpecificData *)
- Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
Tcl_FindExecutable(argv[0]);
tsdPtr->interp = interp;
@@ -194,8 +182,8 @@ Tk_MainEx(argc, argv, appInitProc, interp)
#endif
#ifdef MAC_OSX_TK
- if (TclGetStartupScriptFileName() == NULL) {
- TkMacOSXDefaultStartupScript();
+ if (Tcl_GetStartupScript(NULL) == NULL) {
+ TkMacOSXDefaultStartupScript();
}
#endif
@@ -204,37 +192,51 @@ Tk_MainEx(argc, argv, appInitProc, 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.
+ * 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 (argc > 1) {
- length = strlen(argv[1]);
- if ((length >= 2) && (strncmp(argv[1], "-file", length) == 0)) {
- argc--;
- argv++;
- }
- }
- if (TclGetStartupScriptFileName() == NULL) {
- if ((argc > 1) && (argv[1][0] != '-')) {
- TclSetStartupScriptFileName(argv[1]);
+ 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;
}
}
- /*
- * Make command-line arguments available in the Tcl variables "argc"
- * and "argv".
- */
-
- if (TclGetStartupScriptFileName() == NULL) {
+ path = Tcl_GetStartupScript(&encodingName);
+ if (NULL == path) {
Tcl_ExternalToUtfDString(NULL, argv[0], -1, &appName);
} else {
- TclSetStartupScriptFileName(Tcl_ExternalToUtfDString(NULL,
- TclGetStartupScriptFileName(), -1, &appName));
+ 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);
@@ -246,6 +248,7 @@ Tk_MainEx(argc, argv, appInitProc, interp)
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)));
@@ -265,7 +268,7 @@ Tk_MainEx(argc, argv, appInitProc, interp)
* 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;
@@ -273,8 +276,8 @@ Tk_MainEx(argc, argv, appInitProc, interp)
}
#endif
Tcl_SetVar(interp, "tcl_interactive",
- ((TclGetStartupScriptFileName() == NULL) && (tsdPtr->tty
- || nullStdin)) ? "1" : "0", TCL_GLOBAL_ONLY);
+ ((path == NULL) && (tsdPtr->tty || nullStdin)) ? "1" : "0",
+ TCL_GLOBAL_ONLY);
/*
* Invoke application-specific initialization.
@@ -286,16 +289,18 @@ Tk_MainEx(argc, argv, appInitProc, interp)
}
/*
- * Invoke the script specified on the command line, if any.
+ * Invoke the script specified on the command line, if any. Must fetch it
+ * again, as the appInitProc might have reset it.
*/
- if (TclGetStartupScriptFileName() != NULL) {
+ path = Tcl_GetStartupScript(&encodingName);
+ if (path != NULL) {
Tcl_ResetResult(interp);
- code = Tcl_EvalFile(interp, TclGetStartupScriptFileName());
+ code = Tcl_FSEvalFileEx(interp, path, encodingName);
if (code != TCL_OK) {
/*
- * The following statement guarantees that the errorInfo
- * variable is set properly.
+ * The following statement guarantees that the errorInfo variable
+ * is set properly.
*/
Tcl_AddErrorInfo(interp, "");
@@ -336,13 +341,14 @@ Tk_MainEx(argc, argv, appInitProc, interp)
Tcl_ResetResult(interp);
/*
- * Loop infinitely, waiting for commands to execute. When there
- * are no windows left, Tk_MainLoop returns and we exit.
+ * 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((ClientData) interp);
+ Tcl_SetStartupScript(NULL, NULL);
Tcl_Exit(0);
}
@@ -351,64 +357,60 @@ Tk_MainEx(argc, argv, appInitProc, interp)
*
* 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.
+ * 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.
+ * 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. */
+StdinProc(
+ 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_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;
+ if (count < 0 && !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);
+ &tsdPtr->line), -1);
cmd = Tcl_DStringAppend(&tsdPtr->command, "\n", -1);
Tcl_DStringFree(&tsdPtr->line);
if (!Tcl_CommandComplete(cmd)) {
- gotPartial = 1;
- goto prompt;
+ 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.
+ * 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);
@@ -434,7 +436,7 @@ StdinProc(clientData, mask)
* Output a prompt.
*/
- prompt:
+ prompt:
if (tsdPtr->tty) {
Prompt(interp, gotPartial);
}
@@ -446,25 +448,24 @@ StdinProc(clientData, mask)
*
* Prompt --
*
- * Issue a prompt on standard output, or invoke a script
- * to issue the 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.
+ * 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. */
+Prompt(
+ Tcl_Interp *interp, /* Interpreter to use for prompting. */
+ int partial) /* Non-zero means there already exists a
+ * partial command, so use the secondary
+ * prompt. */
{
Tcl_Obj *promptCmd;
int code;
@@ -473,41 +474,49 @@ Prompt(interp, partial)
promptCmd = Tcl_GetVar2Ex(interp,
partial ? "tcl_prompt2" : "tcl_prompt1", NULL, TCL_GLOBAL_ONLY);
if (promptCmd == NULL) {
-defaultPrompt:
+ 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".
- */
+ /*
+ * 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);
- }
+ if (outChannel != (Tcl_Channel) NULL) {
+ Tcl_WriteChars(outChannel, "% ", 2);
+ }
}
} else {
code = Tcl_EvalObjEx(interp, promptCmd, TCL_EVAL_GLOBAL);
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".
- */
+
+ /*
+ * 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);
- }
+ 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);
+ Tcl_Flush(outChannel);
}
}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */