/* 

 * tclMain.c --

 *

 *	Main program for Tcl shells and other Tcl-based applications.

 *

 * Copyright (c) 1988-1994 The Regents of the University of California.

 * Copyright (c) 1994-1997 Sun Microsystems, Inc.

 * Copyright (c) 2000 Ajuba Solutions.

 * Portions Copyright (c) 2007-2008 Nokia Corporation and/or its subsidiaries. All rights reserved.  

 *

 * See the file "license.terms" for information on usage and redistribution

 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.

 *

 * RCS: @(#) $Id: tclMain.c,v 1.20.2.3 2006/05/05 18:08:58 dgp Exp $

 */

#include "tcl.h"

#include "tclInt.h"

#if defined(__SYMBIAN32__)    

#include "tclPort.h"

#include "tclSymbianGlobals.h"

#include "tclIntPlatDecls.h"

#endif

# undef TCL_STORAGE_CLASS

# define TCL_STORAGE_CLASS DLLEXPORT

/*

 * Declarations for various library procedures and variables (don't want

 * to include tclPort.h here, because people might copy this file out of

 * the Tcl source directory to make their own modified versions).

 */

#if !defined(MAC_TCL)

# if !defined(__SYMBIAN32__)    

extern int		isatty _ANSI_ARGS_((int fd));

# endif

#else

#include <unistd.h>

#endif

static Tcl_Obj *tclStartupScriptPath = NULL;

static Tcl_MainLoopProc *mainLoopProc = NULL;

/* 

 * Structure definition for information used to keep the state of

 * an interactive command processor that reads lines from standard

 * input and writes prompts and results to standard output.

 */

typedef enum {

    PROMPT_NONE,	/* Print no prompt */

    PROMPT_START,	/* Print prompt for command start */

    PROMPT_CONTINUE	/* Print prompt for command continuation */

} PromptType;

typedef struct InteractiveState {

    Tcl_Channel input;		/* The standard input channel from which

				 * lines are read. */

    int tty;                    /* Non-zero means standard input is a 

				 * terminal-like device.  Zero means it's

				 * a file. */

    Tcl_Obj *commandPtr;	/* Used to assemble lines of input into

				 * Tcl commands. */

    PromptType prompt;		/* Next prompt to print */

    Tcl_Interp *interp;		/* Interpreter that evaluates interactive

				 * commands. */

} InteractiveState;

/*

 * Forward declarations for procedures defined later in this file.

 */

static void		Prompt _ANSI_ARGS_((Tcl_Interp *interp,

			    PromptType *promptPtr));

static void		StdinProc _ANSI_ARGS_((ClientData clientData,

			    int mask));

/*

 *----------------------------------------------------------------------

 *

 * TclSetStartupScriptPath --

 *

 *	Primes the startup script VFS path, used to override the

 *      command line processing.

 *

 * Results:

 *	None. 

 *

 * Side effects:

 *	This procedure initializes the VFS path of the Tcl script to

 *      run at startup.

 *

 *----------------------------------------------------------------------

 */

void TclSetStartupScriptPath(pathPtr)

    Tcl_Obj *pathPtr;

{

    if (tclStartupScriptPath != NULL) {

	Tcl_DecrRefCount(tclStartupScriptPath);

    }

    tclStartupScriptPath = pathPtr;

    if (tclStartupScriptPath != NULL) {

	Tcl_IncrRefCount(tclStartupScriptPath);

    }

}

/*

 *----------------------------------------------------------------------

 *

 * TclGetStartupScriptPath --

 *

 *	Gets the startup script VFS path, used to override the

 *      command line processing.

 *

 * Results:

 *	The startup script VFS path, NULL if none has been set.

 *

 * Side effects:

 *	None.

 *

 *----------------------------------------------------------------------

 */

Tcl_Obj *TclGetStartupScriptPath()

{

    return tclStartupScriptPath;

}

/*

 *----------------------------------------------------------------------

 *

 * TclSetStartupScriptFileName --

 *

 *	Primes the startup script file name, used to override the

 *      command line processing.

 *

 * Results:

 *	None. 

 *

 * Side effects:

 *	This procedure initializes the file name of the Tcl script to

 *      run at startup.

 *

 *----------------------------------------------------------------------

 */

void TclSetStartupScriptFileName(fileName)

    CONST char *fileName;

{

    Tcl_Obj *pathPtr = Tcl_NewStringObj(fileName,-1);

    TclSetStartupScriptPath(pathPtr);

}

/*

 *----------------------------------------------------------------------

 *

 * TclGetStartupScriptFileName --

 *

 *	Gets the startup script file name, used to override the

 *      command line processing.

 *

 * Results:

 *	The startup script file name, NULL if none has been set.

 *

 * Side effects:

 *	None.

 *

 *----------------------------------------------------------------------

 */

CONST char *TclGetStartupScriptFileName()

{

    Tcl_Obj *pathPtr = TclGetStartupScriptPath();

    if (pathPtr == NULL) {

	return NULL;

    }

    return Tcl_GetString(pathPtr);

}

/*

 *----------------------------------------------------------------------

 *

 * Tcl_Main --

 *

 *	Main program for tclsh and most other Tcl-based applications.

 *

 * Results:

 *	None. This procedure never returns (it exits the process when

 *	it's done).

 *

 * Side effects:

 *	This procedure initializes the Tcl world and then starts

 *	interpreting commands;  almost anything could happen, depending

 *	on the script being interpreted.

 *

 *----------------------------------------------------------------------

 */

void

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

{

    Tcl_Obj *resultPtr, *argvPtr, *commandPtr = NULL;

    PromptType prompt = PROMPT_START;

    int code, length, tty, exitCode = 0;

    Tcl_Channel inChannel, outChannel, errChannel;

    Tcl_Interp *interp;

    Tcl_DString appName;

    Tcl_Obj *objPtr;

#if defined(__SYMBIAN32__)    

    int isChildProcess = 0;  

    int oldArgc = 0;

#endif  

    Tcl_FindExecutable(argv[0]);

    interp = Tcl_CreateInterp();

#if defined(__SYMBIAN32__)    

    if (ChildProcessInit(&argc, &argv))

 	  {

 	  oldArgc = argc;

 	  argc = argc-4;	

 	  isChildProcess = 1;

 	  }

 #endif    

    Tcl_InitMemory(interp);

    /*

     * Make command-line arguments available in the Tcl variables "argc"

     * and "argv".  If the first argument doesn't start with a "-" then

     * strip it off and use it as the name of a script file to process.

     */

    if (TclGetStartupScriptPath() == NULL) {

	if ((argc > 1) && (argv[1][0] != '-')) {

	    TclSetStartupScriptFileName(argv[1]);

	    argc--;

	    argv++;

	}

    }

    if (TclGetStartupScriptPath() == NULL) {

	Tcl_ExternalToUtfDString(NULL, argv[0], -1, &appName);

    } else {

	TclSetStartupScriptFileName(Tcl_ExternalToUtfDString(NULL,

		TclGetStartupScriptFileName(), -1, &appName));

    }

    Tcl_SetVar(interp, "argv0", Tcl_DStringValue(&appName), TCL_GLOBAL_ONLY);

    Tcl_DStringFree(&appName);

    argc--;

    argv++;

    objPtr = Tcl_NewIntObj(argc);

    Tcl_IncrRefCount(objPtr);

    Tcl_SetVar2Ex(interp, "argc", NULL, objPtr, TCL_GLOBAL_ONLY);

    Tcl_DecrRefCount(objPtr);

    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)));

	Tcl_DStringFree(&ds);

    }

    Tcl_IncrRefCount(argvPtr);

    Tcl_SetVar2Ex(interp, "argv", NULL, argvPtr, TCL_GLOBAL_ONLY);

    Tcl_DecrRefCount(argvPtr);

    /*

     * Set the "tcl_interactive" variable.

     */

    tty = isatty(0);

    Tcl_SetVar(interp, "tcl_interactive",

	    ((TclGetStartupScriptPath() == NULL) && tty) ? "1" : "0",

	    TCL_GLOBAL_ONLY);

    /*

     * Invoke application-specific initialization.

     */

    Tcl_Preserve((ClientData) interp);

    if ((*appInitProc)(interp) != TCL_OK) {

	errChannel = Tcl_GetStdChannel(TCL_STDERR);

	if (errChannel) {

	    Tcl_WriteChars(errChannel,

		    "application-specific initialization failed: ", -1);

	    Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));

	    Tcl_WriteChars(errChannel, "\n", 1);

	}

    }

    if (Tcl_InterpDeleted(interp)) {

	goto done;

    }

    /*

     * If a script file was specified then just source that file

     * and quit.

     */

    if (TclGetStartupScriptPath() != NULL) {

	code = Tcl_FSEvalFile(interp, TclGetStartupScriptPath());

	if (code != TCL_OK) {

	    errChannel = Tcl_GetStdChannel(TCL_STDERR);

	    if (errChannel) {

		/*

		 * The following statement guarantees that the errorInfo

		 * variable is set properly.

		 */

		Tcl_AddErrorInfo(interp, "");

		Tcl_WriteObj(errChannel, Tcl_GetVar2Ex(interp, "errorInfo",

			NULL, TCL_GLOBAL_ONLY));

		Tcl_WriteChars(errChannel, "\n", 1);

	    }

	    exitCode = 1;

	}

	goto done;

    }

    /*

     * We're running interactively.  Source a user-specific startup

     * file if the application specified one and if the file exists.

     */

    Tcl_SourceRCFile(interp);

    /*

     * Process commands from stdin until there's an end-of-file.  Note

     * that we need to fetch the standard channels again after every

     * eval, since they may have been changed.

     */

    commandPtr = Tcl_NewObj();

    Tcl_IncrRefCount(commandPtr);

    /*

     * Get a new value for tty if anyone writes to ::tcl_interactive

     */

    Tcl_LinkVar(interp, "tcl_interactive", (char *) &tty, TCL_LINK_BOOLEAN);

    inChannel = Tcl_GetStdChannel(TCL_STDIN);

    outChannel = Tcl_GetStdChannel(TCL_STDOUT);

    while ((inChannel != (Tcl_Channel) NULL) && !Tcl_InterpDeleted(interp)) {

	if (mainLoopProc == NULL) {

	    if (tty) {

		Prompt(interp, &prompt);

		if (Tcl_InterpDeleted(interp)) {

		    break;

		}

		inChannel = Tcl_GetStdChannel(TCL_STDIN);

		if (inChannel == (Tcl_Channel) NULL) {

	            break;

		}

	    }

	    if (Tcl_IsShared(commandPtr)) {

		Tcl_DecrRefCount(commandPtr);

		commandPtr = Tcl_DuplicateObj(commandPtr);

		Tcl_IncrRefCount(commandPtr);

	    }

            length = Tcl_GetsObj(inChannel, commandPtr);

	    if (length < 0) {

		if (Tcl_InputBlocked(inChannel)) {

		    /*

		     * This can only happen if stdin has been set to

		     * non-blocking.  In that case cycle back and try

		     * again.  This sets up a tight polling loop (since

		     * we have no event loop running).  If this causes

		     * bad CPU hogging, we might try toggling the blocking

		     * on stdin instead.

		     */

		    continue;

		}

		/* 

		 * Either EOF, or an error on stdin; we're done

		 */

		break;

	    }

            /*

             * Add the newline removed by Tcl_GetsObj back to the string.

             */

	    if (Tcl_IsShared(commandPtr)) {

		Tcl_DecrRefCount(commandPtr);

		commandPtr = Tcl_DuplicateObj(commandPtr);

		Tcl_IncrRefCount(commandPtr);

	    }

	    Tcl_AppendToObj(commandPtr, "\n", 1);

	    if (!TclObjCommandComplete(commandPtr)) {

		prompt = PROMPT_CONTINUE;

		continue;

	    }

	    prompt = PROMPT_START;

	    code = Tcl_RecordAndEvalObj(interp, commandPtr, TCL_EVAL_GLOBAL);

	    inChannel = Tcl_GetStdChannel(TCL_STDIN);

	    outChannel = Tcl_GetStdChannel(TCL_STDOUT);

	    errChannel = Tcl_GetStdChannel(TCL_STDERR);

	    Tcl_DecrRefCount(commandPtr);

	    commandPtr = Tcl_NewObj();

	    Tcl_IncrRefCount(commandPtr);

	    if (code != TCL_OK) {

		if (errChannel) {

		    Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));

		    Tcl_WriteChars(errChannel, "\n", 1);

		}

	    } else if (tty) {

		resultPtr = Tcl_GetObjResult(interp);

		Tcl_IncrRefCount(resultPtr);

		Tcl_GetStringFromObj(resultPtr, &length);

		if ((length > 0) && outChannel) {

		    Tcl_WriteObj(outChannel, resultPtr);

		    Tcl_WriteChars(outChannel, "\n", 1);

		}

		Tcl_DecrRefCount(resultPtr);

	    }

	} else {	/* (mainLoopProc != NULL) */

	    /*

	     * If a main loop has been defined while running interactively,

	     * we want to start a fileevent based prompt by establishing a

	     * channel handler for stdin.

	     */

	    InteractiveState *isPtr = NULL;

	    if (inChannel) {

	        if (tty) {

		    Prompt(interp, &prompt);

	        }

		isPtr = (InteractiveState *) 

			ckalloc((int) sizeof(InteractiveState));

		isPtr->input = inChannel;

		isPtr->tty = tty;

		isPtr->commandPtr = commandPtr;

		isPtr->prompt = prompt;

		isPtr->interp = interp;

		Tcl_UnlinkVar(interp, "tcl_interactive");

		Tcl_LinkVar(interp, "tcl_interactive", (char *) &(isPtr->tty),

			TCL_LINK_BOOLEAN);

		Tcl_CreateChannelHandler(inChannel, TCL_READABLE, StdinProc,

			(ClientData) isPtr);

	    }

	    (*mainLoopProc)();

	    mainLoopProc = NULL;

	    if (inChannel) {

		tty = isPtr->tty;

		Tcl_UnlinkVar(interp, "tcl_interactive");

		Tcl_LinkVar(interp, "tcl_interactive", (char *) &tty,

			TCL_LINK_BOOLEAN);

		prompt = isPtr->prompt;

		commandPtr = isPtr->commandPtr;

		if (isPtr->input != (Tcl_Channel) NULL) {

		    Tcl_DeleteChannelHandler(isPtr->input, StdinProc,

			    (ClientData) isPtr);

		}

		ckfree((char *)isPtr);

	    }

	    inChannel = Tcl_GetStdChannel(TCL_STDIN);

	    outChannel = Tcl_GetStdChannel(TCL_STDOUT);

	    errChannel = Tcl_GetStdChannel(TCL_STDERR);

	}

#ifdef TCL_MEM_DEBUG

	/*

	 * This code here only for the (unsupported and deprecated)

	 * [checkmem] command.

	 */

	if (tclMemDumpFileName != NULL) {

	    mainLoopProc = NULL;

	    Tcl_DeleteInterp(interp);

	}

#endif

    }

    done:

    if ((exitCode == 0) && (mainLoopProc != NULL)) {

	/*

	 * If everything has gone OK so far, call the main loop proc,

	 * if it exists.  Packages (like Tk) can set it to start processing

	 * events at this point.

	 */

	(*mainLoopProc)();

	mainLoopProc = NULL;

    }

    if (commandPtr != NULL) {

	Tcl_DecrRefCount(commandPtr);

    }

#if defined(__SYMBIAN32__)

    ChildProcessCleanup(isChildProcess, oldArgc, argv);	  

#else

    close (TCL_STDIN);

    close (TCL_STDOUT);

    close (TCL_STDERR); //every process has a error file

#endif

    /*

     * Rather than calling exit, invoke the "exit" command so that

     * users can replace "exit" with some other command to do additional

     * cleanup on exit.  The Tcl_Eval call should never return.

     */

    if (!Tcl_InterpDeleted(interp)) {

	char buffer[TCL_INTEGER_SPACE + 5];

        sprintf(buffer, "exit %d", exitCode);

        Tcl_Eval(interp, buffer);

        /*

         * If Tcl_Eval returns, trying to eval [exit], something

         * unusual is happening.  Maybe interp has been deleted;

         * maybe [exit] was redefined.  We still want to cleanup

         * and exit.

         */

        if (!Tcl_InterpDeleted(interp)) {

            Tcl_DeleteInterp(interp);

        }

    }

    TclSetStartupScriptPath(NULL);

    /*

     * If we get here, the master interp has been deleted.  Allow

     * its destruction with the last matching Tcl_Release.

     */

    Tcl_Release((ClientData) interp);

    Tcl_Exit(exitCode);

}

/*

 *---------------------------------------------------------------

 *

 * Tcl_SetMainLoop --

 *

 *	Sets an alternative main loop procedure.

 *

 * Results:

 *	Returns the previously defined main loop procedure.

 *

 * Side effects:

 *	This procedure will be called before Tcl exits, allowing for

 *	the creation of an event loop.

 *

 *---------------------------------------------------------------

 */

EXPORT_C void

Tcl_SetMainLoop(proc)

    Tcl_MainLoopProc *proc;

{

    mainLoopProc = proc;

}

/*

 *----------------------------------------------------------------------

 *

 * 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;		/* The state of interactive cmd line */

    int mask;				/* Not used. */

{

    InteractiveState *isPtr = (InteractiveState *) clientData;

    Tcl_Channel chan = isPtr->input;

    Tcl_Obj *commandPtr = isPtr->commandPtr;

    Tcl_Interp *interp = isPtr->interp;

    int code, length;

    if (Tcl_IsShared(commandPtr)) {

	Tcl_DecrRefCount(commandPtr);

	commandPtr = Tcl_DuplicateObj(commandPtr);

	Tcl_IncrRefCount(commandPtr);

    }

    length = Tcl_GetsObj(chan, commandPtr);

    if (length < 0) {

	if (Tcl_InputBlocked(chan)) {

	    return;

	}

	if (isPtr->tty) {

	    /*

	     * Would be better to find a way to exit the mainLoop?

	     * Or perhaps evaluate [exit]?  Leaving as is for now due

	     * to compatibility concerns.

	     */

	    Tcl_Exit(0);

	}

	Tcl_DeleteChannelHandler(chan, StdinProc, (ClientData) isPtr);

	return;

    }

    if (Tcl_IsShared(commandPtr)) {

	Tcl_DecrRefCount(commandPtr);

	commandPtr = Tcl_DuplicateObj(commandPtr);

	Tcl_IncrRefCount(commandPtr);

    }

    Tcl_AppendToObj(commandPtr, "\n", 1);

    if (!TclObjCommandComplete(commandPtr)) {

        isPtr->prompt = PROMPT_CONTINUE;

        goto prompt;

    }

    isPtr->prompt = PROMPT_START;

    /*

     * 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) isPtr);

    code = Tcl_RecordAndEvalObj(interp, commandPtr, TCL_EVAL_GLOBAL);

    isPtr->input = chan = Tcl_GetStdChannel(TCL_STDIN);

    Tcl_DecrRefCount(commandPtr);

    isPtr->commandPtr = commandPtr = Tcl_NewObj();

    Tcl_IncrRefCount(commandPtr);

    if (chan != (Tcl_Channel) NULL) {

	Tcl_CreateChannelHandler(chan, TCL_READABLE, StdinProc,

		(ClientData) isPtr);

    }

    if (code != TCL_OK) {

	Tcl_Channel errChannel = Tcl_GetStdChannel(TCL_STDERR);

	if (errChannel != (Tcl_Channel) NULL) {

	    Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));

	    Tcl_WriteChars(errChannel, "\n", 1);

	}

    } else if (isPtr->tty) {

	Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);

	Tcl_Channel outChannel = Tcl_GetStdChannel(TCL_STDOUT);

	Tcl_IncrRefCount(resultPtr);

	Tcl_GetStringFromObj(resultPtr, &length);

	if ((length >0) && (outChannel != (Tcl_Channel) NULL)) {

	    Tcl_WriteObj(outChannel, resultPtr);

	    Tcl_WriteChars(outChannel, "\n", 1);

	}

	Tcl_DecrRefCount(resultPtr);

    }

    /*

     * If a tty stdin is still around, output a prompt.

     */

    prompt:

    if (isPtr->tty && (isPtr->input != (Tcl_Channel) NULL)) {

	Prompt(interp, &(isPtr->prompt));

	isPtr->input = Tcl_GetStdChannel(TCL_STDIN);

    }

}

/*

 *----------------------------------------------------------------------

 *

 * 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, promptPtr)

    Tcl_Interp *interp;			/* Interpreter to use for prompting. */

    PromptType *promptPtr;		/* Points to type of prompt to print.

					 * Filled with PROMPT_NONE after a

					 * prompt is printed. */

{

    Tcl_Obj *promptCmdPtr;

    int code;

    Tcl_Channel outChannel, errChannel;

    if (*promptPtr == PROMPT_NONE) {

	return;

    }

    promptCmdPtr = Tcl_GetVar2Ex(interp,

	    ((*promptPtr == PROMPT_CONTINUE) ? "tcl_prompt2" : "tcl_prompt1"),

	    NULL, TCL_GLOBAL_ONLY);

    if (Tcl_InterpDeleted(interp)) {

	return;

    }

    if (promptCmdPtr == NULL) {

	defaultPrompt:

	outChannel = Tcl_GetStdChannel(TCL_STDOUT);

	if ((*promptPtr == PROMPT_START)

		&& (outChannel != (Tcl_Channel) NULL)) {

	    Tcl_WriteChars(outChannel, "% ", 2);

	}

    } else {

	code = Tcl_EvalObjEx(interp, promptCmdPtr, TCL_EVAL_GLOBAL);

	if (code != TCL_OK) {

	    Tcl_AddErrorInfo(interp,

		    "\n    (script that generates prompt)");

	    errChannel = Tcl_GetStdChannel(TCL_STDERR);

            if (errChannel != (Tcl_Channel) NULL) {

                Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));

                Tcl_WriteChars(errChannel, "\n", 1);

            }

	    goto defaultPrompt;

	}

    }

    outChannel = Tcl_GetStdChannel(TCL_STDOUT);

    if (outChannel != (Tcl_Channel) NULL) {

	Tcl_Flush(outChannel);

    }

    *promptPtr = PROMPT_NONE;

}