/* 

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

extern int		isatty _ANSI_ARGS_((int fd));

#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];