/* 
 * 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 Tcl_AppInit 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 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/* TkWin version 0.3 -- Tk for Windows
 * Copyright (C) 1994 K. K. Kubota
 * Mathematical Sciences Computing Facility, University of Kentucky,
 * Lexington, KY 40506, USA (e-mail: ken@ms.uky.edu)
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose is granted without fee, provided that the above copyright notice
 * and the following paragraph appear in all copies of this software
 * and supporting documentation.
 *
 * This software is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY, even the implied warranty of MERCHANTABILITY
 * or FITNESS FOR A PARTICULAR PURPOSE.  In no event shall the author be
 * liable to any party for direct, indirect, special, incidental, or
 * consequential damages arising out of the use of this software and its
 * documentation.
 */

static char sccsid[] = "@(#) tkMain.c 1.107 94/12/20 14:31:46";

#include <ctype.h>
#include <stdio.h>
#include <string.h>
#ifdef TCL_MSDOS_PORT
#include "tkInt.h"
#else
#include <tcl.h>
#include <tk.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.
 */

#ifndef TCL_MSDOS_PORT
extern int		isatty _ANSI_ARGS_((int fd));
#endif
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:
 */

#ifdef TCL_MSDOS_PORT
Tk_Window mainWindow;
#else
static Tk_Window mainWindow;	/* The main window for the application.  If
				 * NULL then the application no longer
				 * exists. */
#endif
static Tcl_Interp *interp;	/* Interpreter for this application. */
#ifdef TCL_MSDOS_PORT
char *tk_RcFileName = NULL;
#else
char *tcl_RcFileName = NULL;	/* Name of a user-specific startup script
				 * to source if the application is being run
				 * interactively (e.g. "~/.wishrc").  Set
				 * by Tcl_AppInit.  NULL means don't source
				 * anything ever. */
#endif
static Tcl_DString command;	/* Used to assemble lines of terminal input
				 * into Tcl commands. */
static int tty;			/* Non-zero means standard input is a
				 * terminal-like device.  Zero means it's
				 * a file. */
static char errorExitCmd[] = "exit 1";

/*
 * Command-line options:
 */

#ifndef TCL_MSDOS_PORT
static int synchronize = 0;
#endif
static char *fileName = NULL;
static char *name = NULL;
static char *display = NULL;
static char *geometry = NULL;
#ifdef TCL_MSDOS_PORT
int tcpFlag = 0;
#endif

static Tk_ArgvInfo argTable[] = {
#ifndef TCL_MSDOS_PORT
    {"-display", TK_ARGV_STRING, (char *) NULL, (char *) &display,
	"Display to use"},
#endif
    {"-geometry", TK_ARGV_STRING, (char *) NULL, (char *) &geometry,
	"Initial geometry for window"},
    {"-name", TK_ARGV_STRING, (char *) NULL, (char *) &name,
	"Name to use for application"},
#ifndef TCL_MSDOS_PORT
    {"-sync", TK_ARGV_CONSTANT, (char *) 1, (char *) &synchronize,
	"Use synchronous mode for display server"},
#endif
#ifdef TCL_MSDOS_PORT
    {"-file", TK_ARGV_STRING, (char *) NULL, (char *) &fileName,
	"File from which to read commands"},
    {"-c", TK_ARGV_CONST_OPTION, (char *) NULL, (char *) NULL,
	"Set up main window for interactive tcl input"},
    {"-tcp", TK_ARGV_CONSTANT, (char *) 1, (char *) &tcpFlag,
	"Allow tcp command"},
#endif
    {(char *) NULL, TK_ARGV_END, (char *) NULL, (char *) NULL,
	(char *) NULL}
};

/*
 * Forward declarations for procedures defined later in this file:
 */

#ifndef TCL_MSDOS_PORT
static void		Prompt _ANSI_ARGS_((Tcl_Interp *interp, int partial));
static void		StdinProc _ANSI_ARGS_((ClientData clientData,
			    int mask));
#endif

/*
 *----------------------------------------------------------------------
 *
 * 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.
 *
 *----------------------------------------------------------------------
 */

#ifdef TCL_MSDOS_PORT
static Tcl_DString result;	/* Buffer for results of Tk_Interp_Start */

char * _export Tk_InterpStart(interp, argc, argv)
    Tcl_Interp *interp;
#else
void
Tk_Main(argc, argv)
#endif
    int argc;				/* Number of arguments. */
    char **argv;			/* Array of argument strings. */
{
    char *args, *p, *msg, *argv0, *class;
    char buf[20];
    int code, length;

#ifndef TCL_MSDOS_PORT
    interp = Tcl_CreateInterp();
#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.  Also check
     * for other standard arguments, such as "-geometry", anywhere
     * in the argument list.
     */

#ifdef TCL_MSDOS_PORT
    Tcl_DStringInit(&result);
#endif

    argv0 = argv[0];
    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++;
    }
    if (Tk_ParseArgv(interp, (Tk_Window) NULL, &argc, argv, argTable, 0)
	    != TCL_OK) {
#ifdef TCL_MSDOS_PORT
	Tcl_DStringAppend(&result, interp->result, -1);
	Tcl_DStringAppend(&result, "\n", -1);
	return result.string;
#else
	fprintf(stderr, "%s\n", interp->result);
#endif
	exit(1);
    }
    if (name == NULL) {
	if (fileName != NULL) {
	    p = fileName;
	} else {
	    p = argv[0];
	}
	name = strrchr(p, '/');
	if (name != NULL) {
	    name++;
	} else {
	    name = p;
	}
    }

    /*
     * Make command-line arguments available in the Tcl variables "argc"
     * and "argv".    Also set the "geometry" variable from the geometry
     * specified on the command line.
     */

    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 : argv0,
	    TCL_GLOBAL_ONLY);
    if (geometry != NULL) {
	Tcl_SetVar(interp, "geometry", geometry, TCL_GLOBAL_ONLY);
    }

    /*
     * If a display was specified, put it into the DISPLAY
     * environment variable so that it will be available for
     * any sub-processes created by us.
     */

    if (display != NULL) {
	Tcl_SetVar2(interp, "env", "DISPLAY", display, TCL_GLOBAL_ONLY);
    }

    /*
     * Initialize the Tk application.  If a -name option was provided,
     * use it;  otherwise, if a file name was provided, use the last
     * element of its path as the name of the application; otherwise
     * use the last element of the program name.  For the application's
     * class, capitalize the first letter of the name.
     */

    if (name == NULL) {
	p = (fileName != NULL) ? fileName : argv0;
	name = strrchr(p, '/');
	if (name != NULL) {
	    name++;
	} else {
	    name = p;
	}
    }
#ifdef TCL_MSDOS_PORT
    mainWindow = Tk_CreateMainWindow(interp, display, name, "Tk");
#else
    class = ckalloc((unsigned) (strlen(name) + 1));
    lstrcpy(class, name);
    class[0] = toupper((unsigned char) (class[0]&0x7f));
    mainWindow = Tk_CreateMainWindow(interp, display, name, class);
    ckfree(class);
#endif
    if (mainWindow == NULL) {
#ifdef TCL_MSDOS_PORT
	Tcl_DStringAppend(&result, interp->result, -1);
	Tcl_DStringAppend(&result, "\n", -1);
	return result.string;
#else
	fprintf(stderr, "%s\n", interp->result);
	exit(1);
#endif
    }
#ifndef TCL_MSDOS_PORT
    if (synchronize) {
	XSynchronize(Tk_Display(mainWindow), True);
    }
#endif

    /*
     * Set the "tcl_interactive" variable.
     */

#ifdef TCL_MSDOS_PORT
    Tcl_SetVar(interp, "tcl_interactive",
	    (fileName == NULL) ? "1" : "0", TCL_GLOBAL_ONLY);
#else
    tty = isatty(0);
    Tcl_SetVar(interp, "tcl_interactive",
	    ((fileName == NULL) && tty) ? "1" : "0", TCL_GLOBAL_ONLY);
#endif

    /*
     * Invoke application-specific initialization.
     */

#ifdef TCL_MSDOS_PORT
    if (Tk_AppInit(interp, tcpFlag) != TCL_OK) {
	Tcl_DStringAppend(&result, "Tk_AppInit failed: ", -1);
	Tcl_DStringAppend(&result, interp->result, -1);
	Tcl_DStringAppend(&result, "\n", -1);
	MessageBox(NULL, result.string, "Initialization Error", MB_OK);
    }
#else
    if (Tcl_AppInit(interp) != TCL_OK) {
	fprintf(stderr, "Tcl_AppInit failed: %s\n", interp->result);
    }
#endif

    /*
     * Invoke the script specified on the command line, if any.
     */

#ifdef TCL_MSDOS_PORT
    if(!SetTimer(((TkWindow *)mainWindow)->window, 2, 250, NULL))
	panic("Tk_InterpStart: Out of timers");
#endif

    if (fileName != NULL) {
#ifdef TCL_MSDOS_PORT
	code = Tcl_EvalFile(interp, fileName);
#else
	code = Tcl_VarEval(interp, "source ", fileName, (char *) NULL);
#endif
	if (code != TCL_OK) {
	    goto error;
	}
#ifdef TCL_MSDOS_PORT
	return interp->result;
#else
	tty = 0;
#endif
    } 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.
	 */

#ifdef TCL_MSDOS_PORT
	if (tk_RcFileName != NULL)
#else
	if (tcl_RcFileName != NULL)
#endif
	{
	    Tcl_DString buffer;
	    char *fullName;
	    FILE *f;
    
#ifdef TCL_MSDOS_PORT
	    fullName = Tcl_TildeSubst(interp, tk_RcFileName, &buffer);
#else
	    fullName = Tcl_TildeSubst(interp, tcl_RcFileName, &buffer);
#endif
	    if (fullName == NULL) {
#ifdef TCL_MSDOS_PORT
		/* Don't complain here, as HOME is often not defined. */
#else
		fprintf(stderr, "%s\n", interp->result);
#endif
	    } else {
#ifdef TCL_MSDOS_PORT
		f = fopen(fullName, "rt");
#else
		f = fopen(fullName, "r");
#endif
		if (f != NULL) {
		    code = Tcl_EvalFile(interp, fullName);
		    if (code != TCL_OK) {
#ifdef TCL_MSDOS_PORT
	        	Tcl_DStringAppend(&result, interp->result, -1);
	        	Tcl_DStringAppend(&result, "\n", -1);
#else
			fprintf(stderr, "%s\n", interp->result);
#endif
		    }
		    fclose(f);
		}
	    }
	    Tcl_DStringFree(&buffer);
	}
#ifndef TCL_MSDOS_PORT
	Tk_CreateFileHandler(0, TK_READABLE, StdinProc, (ClientData) 0);
	if (tty) {
	    Prompt(interp, 0);
	}
#endif
    }
#ifndef TCL_MSDOS_PORT
    fflush(stdout);
    Tcl_DStringInit(&command);
    Tcl_ResetResult(interp);
#endif

#ifdef TCL_MSDOS_PORT
    if(fileName != NULL) fileName = NULL;
#endif
    /*
     * Set the geometry of the main window, if requested.  If the "geometry"
     * variable has gone away, this means that the application doesn't want
     * us to set the geometry after all.
     */

    if (geometry != NULL) {
	p = Tcl_GetVar(interp, "geometry", TCL_GLOBAL_ONLY);
	if (p != NULL) {
	    code = Tcl_VarEval(interp, "wm geometry . ", p, (char *) NULL);
	    if (code != TCL_OK) {
#ifdef TCL_MSDOS_PORT
	    Tcl_DStringAppend(&result, interp->result, -1);
	    Tcl_DStringAppend(&result, "\n", -1);
#else
		fprintf(stderr, "%s\n", interp->result);
#endif
	    }
	}
#ifdef TCL_MSDOS_PORT
	geometry = NULL;
#endif
    }
    return result.string;

#ifndef TCL_MSDOS_PORT
    /*
     * Loop infinitely, waiting for commands to execute.  When there
     * are no windows left, Tk_MainLoop returns and we exit.
     */

    Tk_MainLoop();

    /*
     * Don't exit directly, but rather invoke the Tcl "exit" command.
     * This gives the application the opportunity to redefine "exit"
     * to do additional cleanup.
     */

    Tcl_Eval(interp, "exit");
    exit(1);
#endif

error:
    msg = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
    if (msg == NULL) {
	msg = interp->result;
    }
#ifdef TCL_MSDOS_PORT
    Tcl_DStringAppend(&result, msg, -1);
    Tcl_DStringAppend(&result, "\n", -1);
    return result.string;
#else
    fprintf(stderr, "%s\n", msg);
    Tcl_Eval(interp, errorExitCmd);
#endif
}

/*
 *----------------------------------------------------------------------
 *
 * 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.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_MSDOS_PORT
    /* ARGSUSED */
static void
StdinProc(clientData, mask)
    ClientData clientData;		/* Not used. */
    int mask;				/* Not used. */
{
#define BUFFER_SIZE 4000
    char input[BUFFER_SIZE+1];
    static int gotPartial = 0;
    char *cmd;
    int code, count;

    count = read(fileno(stdin), input, BUFFER_SIZE);
    if (count <= 0) {
	if (!gotPartial) {
	    if (tty) {
		Tcl_Eval(interp, "exit");
		exit(1);
	    } else {
		Tk_DeleteFileHandler(0);
	    }
	    return;
	} else {
	    count = 0;
	}
    }
    cmd = Tcl_DStringAppend(&command, input, count);
    if (count != 0) {
	if ((input[count-1] != '\n') && (input[count-1] != ';')) {
	    gotPartial = 1;
	    goto prompt;
	}
	if (!Tcl_CommandComplete(cmd)) {
	    gotPartial = 1;
	    goto prompt;
	}
    }
    gotPartial = 0;

    /*
     * Disable the stdin file 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.
     */

    Tk_CreateFileHandler(0, 0, StdinProc, (ClientData) 0);
    code = Tcl_RecordAndEval(interp, cmd, 0);
    Tk_CreateFileHandler(0, TK_READABLE, StdinProc, (ClientData) 0);
    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.
	     */

	    puts(interp->result);
	}
    }

    /*
     * Output a prompt.
     */

    prompt:
    if (tty) {
	Prompt(interp, gotPartial);
    }
    Tcl_ResetResult(interp);
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * 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.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_MSDOS_PORT
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;

    promptCmd = Tcl_GetVar(interp,
	partial ? "tcl_prompt2" : "tcl_prompt1", TCL_GLOBAL_ONLY);
    if (promptCmd == NULL) {
	defaultPrompt:
	if (!partial) {
	    fputs("% ", stdout);
	}
    } else {
	code = Tcl_Eval(interp, promptCmd);
	if (code != TCL_OK) {
	    Tcl_AddErrorInfo(interp,
		    "\n    (script that generates prompt)");
	    fprintf(stderr, "%s\n", interp->result);
	    goto defaultPrompt;
	}
    }
    fflush(stdout);
}
#endif
