/*
* 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.15 2002/12/13 16:54:35 dgp Exp $
*/
#include <ctype.h>
#include <stdio.h>
#include <string.h>
#include <tcl.h>
#include <tclInt.h>
#include <tk.h>
#include "tkInt.h"
#ifdef NO_STDLIB_H
# include "../compat/stdlib.h"
#else
# include <stdlib.h>
#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;
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.
*/
#if !defined(__WIN32__) && !defined(_WIN32)
#if !defined(MAC_TCL)
extern int isatty _ANSI_ARGS_((int fd));
#else
#include <unistd.h>
#endif
extern char * strrchr _ANSI_ARGS_((CONST char *string, int c));
#endif
/*
* 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. */
Tcl_Interp *interp;
{
char *args;
char buf[TCL_INTEGER_SPACE];
int code;
size_t length;
Tcl_Channel inChannel, outChannel;
Tcl_DString argString;
ThreadSpecificData *tsdPtr;
#ifdef __WIN32__
HANDLE handle;
#endif
/*
* 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.
*/
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]);
argc--;
argv++;
}
}
/*
* Make command-line arguments available in the Tcl variables "argc"
* and "argv".
*/
args = Tcl_Merge(argc-1, (CONST char **)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 (TclGetStartupScriptFileName() == NULL) {
Tcl_ExternalToUtfDString(NULL, argv[0], -1, &argString);
} else {
TclSetStartupScriptFileName(Tcl_ExternalToUtfDString(NULL,
TclGetStartupScriptFileName(), -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",
((TclGetStartupScriptFileName() == NULL)
&& tsdPtr->tty) ? "1" : "0", TCL_GLOBAL_ONLY);
/*
* Invoke application-specific initialization.
*/
if ((*appInitProc)(interp) != TCL_OK) {
TkpDisplayWarning(Tcl_GetStringResult(interp),
"Application initialization failed");
}
/*
* Invoke the script specified on the command line, if any.
*/
if (TclGetStartupScriptFileName() != NULL) {
Tcl_ResetResult(interp);
code = Tcl_EvalFile(interp, TclGetStartupScriptFileName());
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. */
{
Tcl_Obj *promptCmd;
int code;
Tcl_Channel outChannel, errChannel;
promptCmd = Tcl_GetVar2Ex(interp,
partial ? "tcl_prompt2" : "tcl_prompt1", NULL, 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_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".
*/
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);
}
}