438 lines
12 KiB
C
438 lines
12 KiB
C
|
/*
|
|||
|
|
* 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-1996 Sun Microsystems, Inc.
|
|||
|
|
*
|
|||
|
|
* See the file "license.terms" for information on usage and redistribution
|
|||
|
|
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
|||
|
|
*
|
|||
|
|
* SCCS: @(#) tkMain.c 1.148 96/03/25 18:08:43
|
|||
|
|
*/
|
|||
|
|
|
|||
|
|
#include <ctype.h>
|
|||
|
|
#include <stdio.h>
|
|||
|
|
#include <string.h>
|
|||
|
|
#include <tcl.h>
|
|||
|
|
#include <tk.h>
|
|||
|
|
#ifdef NO_STDLIB_H
|
|||
|
|
# include "../compat/stdlib.h"
|
|||
|
|
#else
|
|||
|
|
# include <stdlib.h>
|
|||
|
|
#endif
|
|||
|
|
|
|||
|
|
/*
|
|||
|
|
* 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.
|
|||
|
|
*/
|
|||
|
|
|
|||
|
|
extern int isatty _ANSI_ARGS_((int fd));
|
|||
|
|
extern int read _ANSI_ARGS_((int fd, char *buf, size_t size));
|
|||
|
|
extern char * strrchr _ANSI_ARGS_((CONST char *string, int c));
|
|||
|
|
|
|||
|
|
/*
|
|||
|
|
* Global variables used by the main program:
|
|||
|
|
*/
|
|||
|
|
|
|||
|
|
static Tcl_Interp *interp; /* Interpreter for this application. */
|
|||
|
|
static Tcl_DString command; /* Used to assemble lines of terminal input
|
|||
|
|
* into Tcl commands. */
|
|||
|
|
static Tcl_DString line; /* Used to read the next line from the
|
|||
|
|
* terminal input. */
|
|||
|
|
static int tty; /* Non-zero means standard input is a
|
|||
|
|
* terminal-like device. Zero means it's
|
|||
|
|
* a file. */
|
|||
|
|
|
|||
|
|
/*
|
|||
|
|
* 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_Main --
|
|||
|
|
*
|
|||
|
|
* 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_Main(argc, argv, appInitProc)
|
|||
|
|
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. */
|
|||
|
|
{
|
|||
|
|
char *args, *fileName;
|
|||
|
|
char buf[20];
|
|||
|
|
int code;
|
|||
|
|
size_t length;
|
|||
|
|
Tcl_Channel inChannel, outChannel, errChannel, chan;
|
|||
|
|
|
|||
|
|
Tcl_FindExecutable(argv[0]);
|
|||
|
|
interp = Tcl_CreateInterp();
|
|||
|
|
#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.
|
|||
|
|
*/
|
|||
|
|
|
|||
|
|
fileName = NULL;
|
|||
|
|
if (argc > 1) {
|
|||
|
|
length = strlen(argv[1]);
|
|||
|
|
if ((length >= 2) && (strncmp(argv[1], "-file", length) == 0)) {
|
|||
|
|
argc--;
|
|||
|
|
argv++;
|
|||
|
|
}
|
|||
|
|
}
|
|||
|
|
if ((argc > 1) && (argv[1][0] != '-')) {
|
|||
|
|
fileName = argv[1];
|
|||
|
|
argc--;
|
|||
|
|
argv++;
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
/*
|
|||
|
|
* Make command-line arguments available in the Tcl variables "argc"
|
|||
|
|
* and "argv".
|
|||
|
|
*/
|
|||
|
|
|
|||
|
|
args = Tcl_Merge(argc-1, argv+1);
|
|||
|
|
Tcl_SetVar(interp, "argv", args, TCL_GLOBAL_ONLY);
|
|||
|
|
ckfree(args);
|
|||
|
|
sprintf(buf, "%d", argc-1);
|
|||
|
|
Tcl_SetVar(interp, "argc", buf, TCL_GLOBAL_ONLY);
|
|||
|
|
Tcl_SetVar(interp, "argv0", (fileName != NULL) ? fileName : argv[0],
|
|||
|
|
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__
|
|||
|
|
tty = 1;
|
|||
|
|
#else
|
|||
|
|
tty = isatty(0);
|
|||
|
|
#endif
|
|||
|
|
Tcl_SetVar(interp, "tcl_interactive",
|
|||
|
|
((fileName == NULL) && tty) ? "1" : "0", TCL_GLOBAL_ONLY);
|
|||
|
|
|
|||
|
|
/*
|
|||
|
|
* Invoke application-specific initialization.
|
|||
|
|
*/
|
|||
|
|
|
|||
|
|
if ((*appInitProc)(interp) != TCL_OK) {
|
|||
|
|
errChannel = Tcl_GetStdChannel(TCL_STDERR);
|
|||
|
|
if (errChannel) {
|
|||
|
|
Tcl_Write(errChannel,
|
|||
|
|
"application-specific initialization failed: ", -1);
|
|||
|
|
Tcl_Write(errChannel, interp->result, -1);
|
|||
|
|
Tcl_Write(errChannel, "\n", 1);
|
|||
|
|
}
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
/*
|
|||
|
|
* Invoke the script specified on the command line, if any.
|
|||
|
|
*/
|
|||
|
|
|
|||
|
|
if (fileName != NULL) {
|
|||
|
|
code = Tcl_EvalFile(interp, fileName);
|
|||
|
|
if (code != TCL_OK) {
|
|||
|
|
goto error;
|
|||
|
|
}
|
|||
|
|
tty = 0;
|
|||
|
|
} else {
|
|||
|
|
|
|||
|
|
/*
|
|||
|
|
* Commands will come from standard input, so set up an event
|
|||
|
|
* handler for standard input. Evaluate the .rc file, if one
|
|||
|
|
* has been specified, set up an event handler for standard
|
|||
|
|
* input, and print a prompt if the input device is a terminal.
|
|||
|
|
*/
|
|||
|
|
|
|||
|
|
fileName = Tcl_GetVar(interp, "tcl_rcFileName", TCL_GLOBAL_ONLY);
|
|||
|
|
|
|||
|
|
if (fileName != NULL) {
|
|||
|
|
Tcl_DString buffer;
|
|||
|
|
char *fullName;
|
|||
|
|
|
|||
|
|
fullName = Tcl_TranslateFileName(interp, fileName, &buffer);
|
|||
|
|
if (fullName == NULL) {
|
|||
|
|
errChannel = Tcl_GetStdChannel(TCL_STDERR);
|
|||
|
|
if (errChannel) {
|
|||
|
|
Tcl_Write(errChannel, interp->result, -1);
|
|||
|
|
Tcl_Write(errChannel, "\n", 1);
|
|||
|
|
}
|
|||
|
|
} else {
|
|||
|
|
|
|||
|
|
/*
|
|||
|
|
* NOTE: The following relies on O_RDONLY==0.
|
|||
|
|
*/
|
|||
|
|
|
|||
|
|
chan = Tcl_OpenFileChannel(interp, fullName, "r", 0);
|
|||
|
|
if (chan != (Tcl_Channel) NULL) {
|
|||
|
|
Tcl_Close(NULL, chan);
|
|||
|
|
if (Tcl_EvalFile(interp, fullName) != TCL_OK) {
|
|||
|
|
errChannel = Tcl_GetStdChannel(TCL_STDERR);
|
|||
|
|
if (errChannel) {
|
|||
|
|
Tcl_Write(errChannel, interp->result, -1);
|
|||
|
|
Tcl_Write(errChannel, "\n", 1);
|
|||
|
|
}
|
|||
|
|
}
|
|||
|
|
}
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
Tcl_DStringFree(&buffer);
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
/*
|
|||
|
|
* Establish a channel handler for stdin.
|
|||
|
|
*/
|
|||
|
|
|
|||
|
|
inChannel = Tcl_GetStdChannel(TCL_STDIN);
|
|||
|
|
if (inChannel) {
|
|||
|
|
Tcl_CreateChannelHandler(inChannel, TCL_READABLE, StdinProc,
|
|||
|
|
(ClientData) inChannel);
|
|||
|
|
}
|
|||
|
|
if (tty) {
|
|||
|
|
Prompt(interp, 0);
|
|||
|
|
}
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
outChannel = Tcl_GetStdChannel(TCL_STDOUT);
|
|||
|
|
if (outChannel) {
|
|||
|
|
Tcl_Flush(outChannel);
|
|||
|
|
}
|
|||
|
|
Tcl_DStringInit(&command);
|
|||
|
|
Tcl_DStringInit(&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);
|
|||
|
|
|
|||
|
|
error:
|
|||
|
|
/*
|
|||
|
|
* The following statement guarantees that the errorInfo
|
|||
|
|
* variable is set properly.
|
|||
|
|
*/
|
|||
|
|
|
|||
|
|
Tcl_AddErrorInfo(interp, "");
|
|||
|
|
errChannel = Tcl_GetStdChannel(TCL_STDERR);
|
|||
|
|
if (errChannel) {
|
|||
|
|
Tcl_Write(errChannel, Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY),
|
|||
|
|
-1);
|
|||
|
|
Tcl_Write(errChannel, "\n", 1);
|
|||
|
|
}
|
|||
|
|
Tcl_DeleteInterp(interp);
|
|||
|
|
Tcl_Exit(1);
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
/*
|
|||
|
|
*----------------------------------------------------------------------
|
|||
|
|
*
|
|||
|
|
* 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;
|
|||
|
|
|
|||
|
|
count = Tcl_Gets(chan, &line);
|
|||
|
|
|
|||
|
|
if (count < 0) {
|
|||
|
|
if (!gotPartial) {
|
|||
|
|
if (tty) {
|
|||
|
|
Tcl_Exit(0);
|
|||
|
|
} else {
|
|||
|
|
Tcl_DeleteChannelHandler(chan, StdinProc, (ClientData) chan);
|
|||
|
|
}
|
|||
|
|
return;
|
|||
|
|
} else {
|
|||
|
|
count = 0;
|
|||
|
|
}
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
(void) Tcl_DStringAppend(&command, Tcl_DStringValue(&line), -1);
|
|||
|
|
cmd = Tcl_DStringAppend(&command, "\n", -1);
|
|||
|
|
Tcl_DStringFree(&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);
|
|||
|
|
Tcl_CreateChannelHandler(chan, TCL_READABLE, StdinProc,
|
|||
|
|
(ClientData) chan);
|
|||
|
|
Tcl_DStringFree(&command);
|
|||
|
|
if (*interp->result != 0) {
|
|||
|
|
if ((code != TCL_OK) || (tty)) {
|
|||
|
|
/*
|
|||
|
|
* The statement below used to call "printf", but that resulted
|
|||
|
|
* in core dumps under Solaris 2.3 if the result was very long.
|
|||
|
|
*
|
|||
|
|
* NOTE: This probably will not work under Windows either.
|
|||
|
|
*/
|
|||
|
|
|
|||
|
|
puts(interp->result);
|
|||
|
|
}
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
/*
|
|||
|
|
* Output a prompt.
|
|||
|
|
*/
|
|||
|
|
|
|||
|
|
prompt:
|
|||
|
|
if (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. */
|
|||
|
|
{
|
|||
|
|
char *promptCmd;
|
|||
|
|
int code;
|
|||
|
|
Tcl_Channel outChannel, errChannel;
|
|||
|
|
|
|||
|
|
errChannel = Tcl_GetChannel(interp, "stderr", NULL);
|
|||
|
|
|
|||
|
|
promptCmd = Tcl_GetVar(interp,
|
|||
|
|
partial ? "tcl_prompt2" : "tcl_prompt1", 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_Write(outChannel, "% ", 2);
|
|||
|
|
}
|
|||
|
|
}
|
|||
|
|
} else {
|
|||
|
|
code = Tcl_Eval(interp, promptCmd);
|
|||
|
|
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_Write(errChannel, interp->result, -1);
|
|||
|
|
Tcl_Write(errChannel, "\n", 1);
|
|||
|
|
}
|
|||
|
|
goto defaultPrompt;
|
|||
|
|
}
|
|||
|
|
}
|
|||
|
|
outChannel = Tcl_GetChannel(interp, "stdout", NULL);
|
|||
|
|
if (outChannel != (Tcl_Channel) NULL) {
|
|||
|
|
Tcl_Flush(outChannel);
|
|||
|
|
}
|
|||
|
|
}
|