/* Agent Tcl
 * Bob Gray
 * 3 October 1995
 *
 * tkMain.cc --
 *
 *      Main program for the Tk shell
 *
 * Copyright (c) 1995, Robert S. Gray Dartmouth College
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1995 Sun Microsystems, Inc.
 *
 * See the file "agent.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "platPorting.h"
#include "suppStrings.h"
#include "tcl.h"
#include "tk.h"
#include "agentId.h"
#include "agentTcl.h"
#include "agentTk.h"
#include "genFile.h"
#include "genMessage.h"
#include "genServerInterface.h"
#include "mesgTcpip.h"
#include "genTransmit.h"
#include "tclLocation.h"
#include "tclMasks.h"
#include "truefalse.h"

/*
 * Maximum number of seconds to wait between transmission attempts
 * Maximum number of tranmissions attempts
 */

const int MAXIMUM_SLEEP = 512;
const int MAXIMUM_TRIES = 10;

/*
 * Maximum number of agents that this process can handle before it must exit
 */

const UINT_32 MAXIMUM_AGENTS_PER_PROCESS = 16;
 
/*
 * 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));



/* AgentTk_ServerMain

   Purpose: Execute agents that arrive through the server
 
     Input: appInitProc = procedure to perform application initialization
			  (Agent_AppInitProc)

    Output: The procedure never returns (it exits the process when it 
            finishes).
*/

static void AgentTk_ServerMain (Tcl_AppInitProc *appInitProc)
{
    int code;
    char *result;
    Tcl_Interp *interp;
    Tcl_Interp *masterInterp;

#ifdef REUSE_INTERPRETER

	/*
	 * Create a dummy interpreter so that standard input, output and
	 * error will not be closed when we delete the other interpreters
	 * below.  This is ugly!  The probable solution will be to keep the
	 * same master interpreter from one agent to another (which has speed
	 * benefits too).
	 */

    Tcl_Interp *dummyInterp = Tcl_CreateInterp();

	/*
	 * handle agents until we have handled the maximum number
	 */

    for (UINT_32 i = 0; i < MAXIMUM_AGENTS_PER_PROCESS; ++i) {

#endif

#ifdef FIX_LATER
	    /* version code currently appears in two places (here and in */
	    /* Agent_AppInit in tclAppInit.cc)                           */
#endif
 
#ifndef LANGUAGE_NAME
#define LANGUAGE_NAME "STATE-TK"
#endif

	Version version (LANGUAGE_NAME, TK_MAJOR_VERSION, TK_MINOR_VERSION, 
	    Version::e_PRODUCTION);
	AGENT_TCL *agent = new AGENT_TCL (version);
    
	    /* create the new agent */

	if (agent -> agentRestore () != AGENT_OK) {
	    exit (ServerInterface::e_CAN_NOT_RESTORE_STATE);
	}

	    /* get the interpreters */

	interp = agent -> getInterpreter ();
	masterInterp = agent -> getMasterInterpreter ();
	assert (interp != (Tcl_Interp *) NULL);
	assert (masterInterp != (Tcl_Interp *) NULL);

	    /* initialize the interpreters */

	result = strcpyWithAlloc (interp -> result);

	if ((code = (*appInitProc)(interp)) != TCL_OK) {
	    Tcl_AddErrorInfo (interp, "\n    (*** initialization script ***)");
            Agent_SendResult (interp, MAXIMUM_TRIES, MAXIMUM_SLEEP, code);
	    Tcl_DeleteInterp (interp);
	    Tcl_Exit (0);
        }

        Tcl_SetResult (interp, result, TCL_DYNAMIC);
	result = NULL;

	    /* execute the agent */

	code = agent -> agentRun ();

	    /* send the result to the root agent and exit */

	if (interp->resultCode != TCL_REWIND) {
	    Agent_SendResult (interp, 
		MAXIMUM_TRIES, MAXIMUM_SLEEP, interp -> resultCode);
	}

	    /* delete everything */

#ifdef FIX_LATER
	    /* The cleanup handler for interp (1) automatically deletes the */
	    /* Agent instance that was created above and (2) automatically  */
	    /* calls agentEnd -- this may not be what we want long term.    */
#endif
	 
	Tcl_DeleteInterp (interp);
	Tcl_DeleteInterp (masterInterp);
	masterInterp = NULL;
	interp = NULL;
	
#ifdef REUSE_INTERPRETER
    }
#endif

	/* exit */

    Tcl_Exit (0);
    abort_with_message ("should never get here");   // should never get here
}

/*
 *----------------------------------------------------------------------
 *
 * AgentTk_Main --
 *
 *	Main program for Wish and most other Tk-based applications.
 *
 * Input:
 *
 *      argc        = number of arguments
 *      argv        = the arguments
 *      appInitProc = application-specific initialization procedure to call
 *                    after most initialization but before starting to
 *                    execute commands
 *  
 * 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 AgentTk_Main (int argc, char **argv, Tcl_AppInitProc *appInitProc)
{
    Tcl_Channel inChannel, outChannel, errChannel, chan;
    char *args, *argv0;
    char *fileName = NULL;
    size_t length;
    char buf[20];
    int code;

    /*
     * Handle agents that arrive via the server -- AgentTk_ServerMain never returns!
     */

    if ((argc > 1) && (!strcmp(argv[1], "-agent"))) {
	AgentTk_ServerMain (appInitProc);
    }

    /* 
     * Find the executable and create the interpreter.
     */

    interp = Tcl_CreateInterp();
    Tcl_FindExecutable (argv[0]);

    /*
     * 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.
     */

    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++;
    } 

    /*
     * 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 : argv0, 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_SetInteractive (interp, ((fileName == NULL) && tty));

    /*
     * 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) {
	Tcl_AllowStateCapture(interp);
	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.  
     */

    while (1) {
	Tk_DoOneEvent (0);
    }

    exit (1);   // should never reach this statement

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 clientData, int)
{
    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);
    Tcl_AllowStateCapture(interp);
    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(Tcl_Interp *interp, int partial)
{
    char *promptCmd;
    int code;
    Tcl_Channel outChannel, errChannel;

    errChannel = Tcl_GetChannel(interp, "stderr", NULL);

    promptCmd = Tcl_GetVar(interp,
	(char *) (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, "agent-tk> ", 10);
            }
	}
    } 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);
    }
}
