sl@0: /* 
sl@0:  * tclMain.c --
sl@0:  *
sl@0:  *	Main program for Tcl shells and other Tcl-based applications.
sl@0:  *
sl@0:  * Copyright (c) 1988-1994 The Regents of the University of California.
sl@0:  * Copyright (c) 1994-1997 Sun Microsystems, Inc.
sl@0:  * Copyright (c) 2000 Ajuba Solutions.
sl@0:  * Portions Copyright (c) 2007-2008 Nokia Corporation and/or its subsidiaries. All rights reserved.  
sl@0:  *
sl@0:  * See the file "license.terms" for information on usage and redistribution
sl@0:  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
sl@0:  *
sl@0:  * RCS: @(#) $Id: tclMain.c,v 1.20.2.3 2006/05/05 18:08:58 dgp Exp $
sl@0:  */
sl@0: 
sl@0: #include "tcl.h"
sl@0: #include "tclInt.h"
sl@0: #if defined(__SYMBIAN32__)    
sl@0: #include "tclPort.h"
sl@0: #include "tclSymbianGlobals.h"
sl@0: #include "tclIntPlatDecls.h"
sl@0: #endif
sl@0: 
sl@0: # undef TCL_STORAGE_CLASS
sl@0: # define TCL_STORAGE_CLASS DLLEXPORT
sl@0: 
sl@0: /*
sl@0:  * Declarations for various library procedures and variables (don't want
sl@0:  * to include tclPort.h here, because people might copy this file out of
sl@0:  * the Tcl source directory to make their own modified versions).
sl@0:  */
sl@0: 
sl@0: #if !defined(MAC_TCL)
sl@0: # if !defined(__SYMBIAN32__)    
sl@0: extern int		isatty _ANSI_ARGS_((int fd));
sl@0: # endif
sl@0: #else
sl@0: #include <unistd.h>
sl@0: #endif
sl@0: 
sl@0: static Tcl_Obj *tclStartupScriptPath = NULL;
sl@0: 
sl@0: static Tcl_MainLoopProc *mainLoopProc = NULL;
sl@0: 
sl@0: /* 
sl@0:  * Structure definition for information used to keep the state of
sl@0:  * an interactive command processor that reads lines from standard
sl@0:  * input and writes prompts and results to standard output.
sl@0:  */
sl@0: 
sl@0: typedef enum {
sl@0:     PROMPT_NONE,	/* Print no prompt */
sl@0:     PROMPT_START,	/* Print prompt for command start */
sl@0:     PROMPT_CONTINUE	/* Print prompt for command continuation */
sl@0: } PromptType;
sl@0: 
sl@0: typedef struct InteractiveState {
sl@0:     Tcl_Channel input;		/* The standard input channel from which
sl@0: 				 * lines are read. */
sl@0:     int tty;                    /* Non-zero means standard input is a 
sl@0: 				 * terminal-like device.  Zero means it's
sl@0: 				 * a file. */
sl@0:     Tcl_Obj *commandPtr;	/* Used to assemble lines of input into
sl@0: 				 * Tcl commands. */
sl@0:     PromptType prompt;		/* Next prompt to print */
sl@0:     Tcl_Interp *interp;		/* Interpreter that evaluates interactive
sl@0: 				 * commands. */
sl@0: } InteractiveState;
sl@0: 
sl@0: /*
sl@0:  * Forward declarations for procedures defined later in this file.
sl@0:  */
sl@0: 
sl@0: static void		Prompt _ANSI_ARGS_((Tcl_Interp *interp,
sl@0: 			    PromptType *promptPtr));
sl@0: static void		StdinProc _ANSI_ARGS_((ClientData clientData,
sl@0: 			    int mask));
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * TclSetStartupScriptPath --
sl@0:  *
sl@0:  *	Primes the startup script VFS path, used to override the
sl@0:  *      command line processing.
sl@0:  *
sl@0:  * Results:
sl@0:  *	None. 
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	This procedure initializes the VFS path of the Tcl script to
sl@0:  *      run at startup.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: void TclSetStartupScriptPath(pathPtr)
sl@0:     Tcl_Obj *pathPtr;
sl@0: {
sl@0:     if (tclStartupScriptPath != NULL) {
sl@0: 	Tcl_DecrRefCount(tclStartupScriptPath);
sl@0:     }
sl@0:     tclStartupScriptPath = pathPtr;
sl@0:     if (tclStartupScriptPath != NULL) {
sl@0: 	Tcl_IncrRefCount(tclStartupScriptPath);
sl@0:     }
sl@0: }
sl@0: 
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * TclGetStartupScriptPath --
sl@0:  *
sl@0:  *	Gets the startup script VFS path, used to override the
sl@0:  *      command line processing.
sl@0:  *
sl@0:  * Results:
sl@0:  *	The startup script VFS path, NULL if none has been set.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	None.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: Tcl_Obj *TclGetStartupScriptPath()
sl@0: {
sl@0:     return tclStartupScriptPath;
sl@0: }
sl@0: 
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * TclSetStartupScriptFileName --
sl@0:  *
sl@0:  *	Primes the startup script file name, used to override the
sl@0:  *      command line processing.
sl@0:  *
sl@0:  * Results:
sl@0:  *	None. 
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	This procedure initializes the file name of the Tcl script to
sl@0:  *      run at startup.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: void TclSetStartupScriptFileName(fileName)
sl@0:     CONST char *fileName;
sl@0: {
sl@0:     Tcl_Obj *pathPtr = Tcl_NewStringObj(fileName,-1);
sl@0:     TclSetStartupScriptPath(pathPtr);
sl@0: }
sl@0: 
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * TclGetStartupScriptFileName --
sl@0:  *
sl@0:  *	Gets the startup script file name, used to override the
sl@0:  *      command line processing.
sl@0:  *
sl@0:  * Results:
sl@0:  *	The startup script file name, NULL if none has been set.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	None.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: CONST char *TclGetStartupScriptFileName()
sl@0: {
sl@0:     Tcl_Obj *pathPtr = TclGetStartupScriptPath();
sl@0: 
sl@0:     if (pathPtr == NULL) {
sl@0: 	return NULL;
sl@0:     }
sl@0:     return Tcl_GetString(pathPtr);
sl@0: }
sl@0: 
sl@0: 
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * Tcl_Main --
sl@0:  *
sl@0:  *	Main program for tclsh and most other Tcl-based applications.
sl@0:  *
sl@0:  * Results:
sl@0:  *	None. This procedure never returns (it exits the process when
sl@0:  *	it's done).
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	This procedure initializes the Tcl world and then starts
sl@0:  *	interpreting commands;  almost anything could happen, depending
sl@0:  *	on the script being interpreted.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: void
sl@0: Tcl_Main(argc, argv, appInitProc)
sl@0:     int argc;			/* Number of arguments. */
sl@0:     char **argv;		/* Array of argument strings. */
sl@0:     Tcl_AppInitProc *appInitProc;
sl@0: 				/* Application-specific initialization
sl@0: 				 * procedure to call after most
sl@0: 				 * initialization but before starting to
sl@0: 				 * execute commands. */
sl@0: {
sl@0:     Tcl_Obj *resultPtr, *argvPtr, *commandPtr = NULL;
sl@0:     PromptType prompt = PROMPT_START;
sl@0:     int code, length, tty, exitCode = 0;
sl@0:     Tcl_Channel inChannel, outChannel, errChannel;
sl@0:     Tcl_Interp *interp;
sl@0:     Tcl_DString appName;
sl@0:     Tcl_Obj *objPtr;
sl@0:     
sl@0: #if defined(__SYMBIAN32__)    
sl@0:     int isChildProcess = 0;  
sl@0:     int oldArgc = 0;
sl@0: #endif  
sl@0:     Tcl_FindExecutable(argv[0]);
sl@0:     interp = Tcl_CreateInterp();
sl@0:     
sl@0: #if defined(__SYMBIAN32__)    
sl@0:     if (ChildProcessInit(&argc, &argv))
sl@0:  	  {
sl@0:  	  oldArgc = argc;
sl@0:  	  argc = argc-4;	
sl@0:  	  isChildProcess = 1;
sl@0:  	  }
sl@0:  #endif    
sl@0:     
sl@0:     Tcl_InitMemory(interp);
sl@0: 
sl@0:     /*
sl@0:      * Make command-line arguments available in the Tcl variables "argc"
sl@0:      * and "argv".  If the first argument doesn't start with a "-" then
sl@0:      * strip it off and use it as the name of a script file to process.
sl@0:      */
sl@0: 
sl@0:     if (TclGetStartupScriptPath() == NULL) {
sl@0: 	if ((argc > 1) && (argv[1][0] != '-')) {
sl@0: 	    TclSetStartupScriptFileName(argv[1]);
sl@0: 	    argc--;
sl@0: 	    argv++;
sl@0: 	}
sl@0:     }
sl@0: 
sl@0:     if (TclGetStartupScriptPath() == NULL) {
sl@0: 	Tcl_ExternalToUtfDString(NULL, argv[0], -1, &appName);
sl@0:     } else {
sl@0: 	TclSetStartupScriptFileName(Tcl_ExternalToUtfDString(NULL,
sl@0: 		TclGetStartupScriptFileName(), -1, &appName));
sl@0:     }
sl@0:     Tcl_SetVar(interp, "argv0", Tcl_DStringValue(&appName), TCL_GLOBAL_ONLY);
sl@0:     Tcl_DStringFree(&appName);
sl@0:     argc--;
sl@0:     argv++;
sl@0: 
sl@0:     objPtr = Tcl_NewIntObj(argc);
sl@0:     Tcl_IncrRefCount(objPtr);
sl@0:     Tcl_SetVar2Ex(interp, "argc", NULL, objPtr, TCL_GLOBAL_ONLY);
sl@0:     Tcl_DecrRefCount(objPtr);
sl@0:     
sl@0:     argvPtr = Tcl_NewListObj(0, NULL);
sl@0:     while (argc--) {
sl@0: 	Tcl_DString ds;
sl@0: 	Tcl_ExternalToUtfDString(NULL, *argv++, -1, &ds);
sl@0: 	Tcl_ListObjAppendElement(NULL, argvPtr, Tcl_NewStringObj(
sl@0: 		Tcl_DStringValue(&ds), Tcl_DStringLength(&ds)));
sl@0: 	Tcl_DStringFree(&ds);
sl@0:     }
sl@0:     Tcl_IncrRefCount(argvPtr);
sl@0:     Tcl_SetVar2Ex(interp, "argv", NULL, argvPtr, TCL_GLOBAL_ONLY);
sl@0:     Tcl_DecrRefCount(argvPtr);
sl@0: 
sl@0:     /*
sl@0:      * Set the "tcl_interactive" variable.
sl@0:      */
sl@0: 
sl@0:     tty = isatty(0);
sl@0:     Tcl_SetVar(interp, "tcl_interactive",
sl@0: 	    ((TclGetStartupScriptPath() == NULL) && tty) ? "1" : "0",
sl@0: 	    TCL_GLOBAL_ONLY);
sl@0:     
sl@0:     /*
sl@0:      * Invoke application-specific initialization.
sl@0:      */
sl@0: 
sl@0:     Tcl_Preserve((ClientData) interp);
sl@0:     if ((*appInitProc)(interp) != TCL_OK) {
sl@0: 	errChannel = Tcl_GetStdChannel(TCL_STDERR);
sl@0: 	if (errChannel) {
sl@0: 	    Tcl_WriteChars(errChannel,
sl@0: 		    "application-specific initialization failed: ", -1);
sl@0: 	    Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
sl@0: 	    Tcl_WriteChars(errChannel, "\n", 1);
sl@0: 	}
sl@0:     }
sl@0:     if (Tcl_InterpDeleted(interp)) {
sl@0: 	goto done;
sl@0:     }
sl@0: 
sl@0:     /*
sl@0:      * If a script file was specified then just source that file
sl@0:      * and quit.
sl@0:      */
sl@0: 
sl@0:     if (TclGetStartupScriptPath() != NULL) {
sl@0: 	code = Tcl_FSEvalFile(interp, TclGetStartupScriptPath());
sl@0: 	if (code != TCL_OK) {
sl@0: 	    errChannel = Tcl_GetStdChannel(TCL_STDERR);
sl@0: 	    if (errChannel) {
sl@0: 
sl@0: 		/*
sl@0: 		 * The following statement guarantees that the errorInfo
sl@0: 		 * variable is set properly.
sl@0: 		 */
sl@0: 
sl@0: 		Tcl_AddErrorInfo(interp, "");
sl@0: 		Tcl_WriteObj(errChannel, Tcl_GetVar2Ex(interp, "errorInfo",
sl@0: 			NULL, TCL_GLOBAL_ONLY));
sl@0: 		Tcl_WriteChars(errChannel, "\n", 1);
sl@0: 	    }
sl@0: 	    exitCode = 1;
sl@0: 	}
sl@0: 	goto done;
sl@0:     }
sl@0: 
sl@0:     /*
sl@0:      * We're running interactively.  Source a user-specific startup
sl@0:      * file if the application specified one and if the file exists.
sl@0:      */
sl@0: 
sl@0:     Tcl_SourceRCFile(interp);
sl@0: 
sl@0:     /*
sl@0:      * Process commands from stdin until there's an end-of-file.  Note
sl@0:      * that we need to fetch the standard channels again after every
sl@0:      * eval, since they may have been changed.
sl@0:      */
sl@0: 
sl@0:     commandPtr = Tcl_NewObj();
sl@0:     Tcl_IncrRefCount(commandPtr);
sl@0: 
sl@0:     /*
sl@0:      * Get a new value for tty if anyone writes to ::tcl_interactive
sl@0:      */
sl@0:     Tcl_LinkVar(interp, "tcl_interactive", (char *) &tty, TCL_LINK_BOOLEAN);
sl@0:     inChannel = Tcl_GetStdChannel(TCL_STDIN);
sl@0:     outChannel = Tcl_GetStdChannel(TCL_STDOUT);
sl@0:     while ((inChannel != (Tcl_Channel) NULL) && !Tcl_InterpDeleted(interp)) {
sl@0: 	if (mainLoopProc == NULL) {
sl@0: 	    if (tty) {
sl@0: 		Prompt(interp, &prompt);
sl@0: 		if (Tcl_InterpDeleted(interp)) {
sl@0: 		    break;
sl@0: 		}
sl@0: 		inChannel = Tcl_GetStdChannel(TCL_STDIN);
sl@0: 		if (inChannel == (Tcl_Channel) NULL) {
sl@0: 	            break;
sl@0: 		}
sl@0: 	    }
sl@0: 	    if (Tcl_IsShared(commandPtr)) {
sl@0: 		Tcl_DecrRefCount(commandPtr);
sl@0: 		commandPtr = Tcl_DuplicateObj(commandPtr);
sl@0: 		Tcl_IncrRefCount(commandPtr);
sl@0: 	    }
sl@0:             length = Tcl_GetsObj(inChannel, commandPtr);
sl@0: 	    if (length < 0) {
sl@0: 		if (Tcl_InputBlocked(inChannel)) {
sl@0: 
sl@0: 		    /*
sl@0: 		     * This can only happen if stdin has been set to
sl@0: 		     * non-blocking.  In that case cycle back and try
sl@0: 		     * again.  This sets up a tight polling loop (since
sl@0: 		     * we have no event loop running).  If this causes
sl@0: 		     * bad CPU hogging, we might try toggling the blocking
sl@0: 		     * on stdin instead.
sl@0: 		     */
sl@0: 
sl@0: 		    continue;
sl@0: 		}
sl@0: 
sl@0: 		/* 
sl@0: 		 * Either EOF, or an error on stdin; we're done
sl@0: 		 */
sl@0: 
sl@0: 		break;
sl@0: 	    }
sl@0: 
sl@0:             /*
sl@0:              * Add the newline removed by Tcl_GetsObj back to the string.
sl@0:              */
sl@0: 
sl@0: 	    if (Tcl_IsShared(commandPtr)) {
sl@0: 		Tcl_DecrRefCount(commandPtr);
sl@0: 		commandPtr = Tcl_DuplicateObj(commandPtr);
sl@0: 		Tcl_IncrRefCount(commandPtr);
sl@0: 	    }
sl@0: 	    Tcl_AppendToObj(commandPtr, "\n", 1);
sl@0: 	    if (!TclObjCommandComplete(commandPtr)) {
sl@0: 		prompt = PROMPT_CONTINUE;
sl@0: 		continue;
sl@0: 	    }
sl@0: 
sl@0: 	    prompt = PROMPT_START;
sl@0: 	    code = Tcl_RecordAndEvalObj(interp, commandPtr, TCL_EVAL_GLOBAL);
sl@0: 	    inChannel = Tcl_GetStdChannel(TCL_STDIN);
sl@0: 	    outChannel = Tcl_GetStdChannel(TCL_STDOUT);
sl@0: 	    errChannel = Tcl_GetStdChannel(TCL_STDERR);
sl@0: 	    Tcl_DecrRefCount(commandPtr);
sl@0: 	    commandPtr = Tcl_NewObj();
sl@0: 	    Tcl_IncrRefCount(commandPtr);
sl@0: 	    if (code != TCL_OK) {
sl@0: 		if (errChannel) {
sl@0: 		    Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
sl@0: 		    Tcl_WriteChars(errChannel, "\n", 1);
sl@0: 		}
sl@0: 	    } else if (tty) {
sl@0: 		resultPtr = Tcl_GetObjResult(interp);
sl@0: 		Tcl_IncrRefCount(resultPtr);
sl@0: 		Tcl_GetStringFromObj(resultPtr, &length);
sl@0: 		if ((length > 0) && outChannel) {
sl@0: 		    Tcl_WriteObj(outChannel, resultPtr);
sl@0: 		    Tcl_WriteChars(outChannel, "\n", 1);
sl@0: 		}
sl@0: 		Tcl_DecrRefCount(resultPtr);
sl@0: 	    }
sl@0: 	} else {	/* (mainLoopProc != NULL) */
sl@0: 	    /*
sl@0: 	     * If a main loop has been defined while running interactively,
sl@0: 	     * we want to start a fileevent based prompt by establishing a
sl@0: 	     * channel handler for stdin.
sl@0: 	     */
sl@0: 
sl@0: 	    InteractiveState *isPtr = NULL;
sl@0: 
sl@0: 	    if (inChannel) {
sl@0: 	        if (tty) {
sl@0: 		    Prompt(interp, &prompt);
sl@0: 	        }
sl@0: 		isPtr = (InteractiveState *) 
sl@0: 			ckalloc((int) sizeof(InteractiveState));
sl@0: 		isPtr->input = inChannel;
sl@0: 		isPtr->tty = tty;
sl@0: 		isPtr->commandPtr = commandPtr;
sl@0: 		isPtr->prompt = prompt;
sl@0: 		isPtr->interp = interp;
sl@0: 
sl@0: 		Tcl_UnlinkVar(interp, "tcl_interactive");
sl@0: 		Tcl_LinkVar(interp, "tcl_interactive", (char *) &(isPtr->tty),
sl@0: 			TCL_LINK_BOOLEAN);
sl@0: 
sl@0: 		Tcl_CreateChannelHandler(inChannel, TCL_READABLE, StdinProc,
sl@0: 			(ClientData) isPtr);
sl@0: 	    }
sl@0: 
sl@0: 	    (*mainLoopProc)();
sl@0: 	    mainLoopProc = NULL;
sl@0: 
sl@0: 	    if (inChannel) {
sl@0: 		tty = isPtr->tty;
sl@0: 		Tcl_UnlinkVar(interp, "tcl_interactive");
sl@0: 		Tcl_LinkVar(interp, "tcl_interactive", (char *) &tty,
sl@0: 			TCL_LINK_BOOLEAN);
sl@0: 		prompt = isPtr->prompt;
sl@0: 		commandPtr = isPtr->commandPtr;
sl@0: 		if (isPtr->input != (Tcl_Channel) NULL) {
sl@0: 		    Tcl_DeleteChannelHandler(isPtr->input, StdinProc,
sl@0: 			    (ClientData) isPtr);
sl@0: 		}
sl@0: 		ckfree((char *)isPtr);
sl@0: 	    }
sl@0: 	    inChannel = Tcl_GetStdChannel(TCL_STDIN);
sl@0: 	    outChannel = Tcl_GetStdChannel(TCL_STDOUT);
sl@0: 	    errChannel = Tcl_GetStdChannel(TCL_STDERR);
sl@0: 	}
sl@0: #ifdef TCL_MEM_DEBUG
sl@0: 
sl@0: 	/*
sl@0: 	 * This code here only for the (unsupported and deprecated)
sl@0: 	 * [checkmem] command.
sl@0: 	 */
sl@0: 
sl@0: 	if (tclMemDumpFileName != NULL) {
sl@0: 	    mainLoopProc = NULL;
sl@0: 	    Tcl_DeleteInterp(interp);
sl@0: 	}
sl@0: #endif
sl@0:     }
sl@0: 
sl@0:     done:
sl@0:     if ((exitCode == 0) && (mainLoopProc != NULL)) {
sl@0: 
sl@0: 	/*
sl@0: 	 * If everything has gone OK so far, call the main loop proc,
sl@0: 	 * if it exists.  Packages (like Tk) can set it to start processing
sl@0: 	 * events at this point.
sl@0: 	 */
sl@0: 
sl@0: 	(*mainLoopProc)();
sl@0: 	mainLoopProc = NULL;
sl@0:     }
sl@0:     if (commandPtr != NULL) {
sl@0: 	Tcl_DecrRefCount(commandPtr);
sl@0:     }
sl@0: 
sl@0: #if defined(__SYMBIAN32__)
sl@0:     ChildProcessCleanup(isChildProcess, oldArgc, argv);	  
sl@0: #else
sl@0:     close (TCL_STDIN);
sl@0:     close (TCL_STDOUT);
sl@0:     close (TCL_STDERR); //every process has a error file
sl@0: #endif
sl@0: 
sl@0:     /*
sl@0:      * Rather than calling exit, invoke the "exit" command so that
sl@0:      * users can replace "exit" with some other command to do additional
sl@0:      * cleanup on exit.  The Tcl_Eval call should never return.
sl@0:      */
sl@0: 
sl@0:     if (!Tcl_InterpDeleted(interp)) {
sl@0: 	char buffer[TCL_INTEGER_SPACE + 5];
sl@0:         sprintf(buffer, "exit %d", exitCode);
sl@0:         Tcl_Eval(interp, buffer);
sl@0: 
sl@0:         /*
sl@0:          * If Tcl_Eval returns, trying to eval [exit], something
sl@0:          * unusual is happening.  Maybe interp has been deleted;
sl@0:          * maybe [exit] was redefined.  We still want to cleanup
sl@0:          * and exit.
sl@0:          */
sl@0: 
sl@0:         if (!Tcl_InterpDeleted(interp)) {
sl@0:             Tcl_DeleteInterp(interp);
sl@0:         }
sl@0:     }
sl@0:     TclSetStartupScriptPath(NULL);
sl@0: 
sl@0:     /*
sl@0:      * If we get here, the master interp has been deleted.  Allow
sl@0:      * its destruction with the last matching Tcl_Release.
sl@0:      */
sl@0: 
sl@0:     Tcl_Release((ClientData) interp);
sl@0:     Tcl_Exit(exitCode);
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *---------------------------------------------------------------
sl@0:  *
sl@0:  * Tcl_SetMainLoop --
sl@0:  *
sl@0:  *	Sets an alternative main loop procedure.
sl@0:  *
sl@0:  * Results:
sl@0:  *	Returns the previously defined main loop procedure.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	This procedure will be called before Tcl exits, allowing for
sl@0:  *	the creation of an event loop.
sl@0:  *
sl@0:  *---------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: EXPORT_C void
sl@0: Tcl_SetMainLoop(proc)
sl@0:     Tcl_MainLoopProc *proc;
sl@0: {
sl@0:     mainLoopProc = proc;
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * StdinProc --
sl@0:  *
sl@0:  *	This procedure is invoked by the event dispatcher whenever
sl@0:  *	standard input becomes readable.  It grabs the next line of
sl@0:  *	input characters, adds them to a command being assembled, and
sl@0:  *	executes the command if it's complete.
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	Could be almost arbitrary, depending on the command that's
sl@0:  *	typed.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0:     /* ARGSUSED */
sl@0: static void
sl@0: StdinProc(clientData, mask)
sl@0:     ClientData clientData;		/* The state of interactive cmd line */
sl@0:     int mask;				/* Not used. */
sl@0: {
sl@0:     InteractiveState *isPtr = (InteractiveState *) clientData;
sl@0:     Tcl_Channel chan = isPtr->input;
sl@0:     Tcl_Obj *commandPtr = isPtr->commandPtr;
sl@0:     Tcl_Interp *interp = isPtr->interp;
sl@0:     int code, length;
sl@0: 
sl@0:     if (Tcl_IsShared(commandPtr)) {
sl@0: 	Tcl_DecrRefCount(commandPtr);
sl@0: 	commandPtr = Tcl_DuplicateObj(commandPtr);
sl@0: 	Tcl_IncrRefCount(commandPtr);
sl@0:     }
sl@0:     length = Tcl_GetsObj(chan, commandPtr);
sl@0:     if (length < 0) {
sl@0: 	if (Tcl_InputBlocked(chan)) {
sl@0: 	    return;
sl@0: 	}
sl@0: 	if (isPtr->tty) {
sl@0: 	    /*
sl@0: 	     * Would be better to find a way to exit the mainLoop?
sl@0: 	     * Or perhaps evaluate [exit]?  Leaving as is for now due
sl@0: 	     * to compatibility concerns.
sl@0: 	     */
sl@0: 	    Tcl_Exit(0);
sl@0: 	}
sl@0: 	Tcl_DeleteChannelHandler(chan, StdinProc, (ClientData) isPtr);
sl@0: 	return;
sl@0:     }
sl@0: 
sl@0:     if (Tcl_IsShared(commandPtr)) {
sl@0: 	Tcl_DecrRefCount(commandPtr);
sl@0: 	commandPtr = Tcl_DuplicateObj(commandPtr);
sl@0: 	Tcl_IncrRefCount(commandPtr);
sl@0:     }
sl@0:     Tcl_AppendToObj(commandPtr, "\n", 1);
sl@0:     if (!TclObjCommandComplete(commandPtr)) {
sl@0:         isPtr->prompt = PROMPT_CONTINUE;
sl@0:         goto prompt;
sl@0:     }
sl@0:     isPtr->prompt = PROMPT_START;
sl@0: 
sl@0:     /*
sl@0:      * Disable the stdin channel handler while evaluating the command;
sl@0:      * otherwise if the command re-enters the event loop we might
sl@0:      * process commands from stdin before the current command is
sl@0:      * finished.  Among other things, this will trash the text of the
sl@0:      * command being evaluated.
sl@0:      */
sl@0: 
sl@0:     Tcl_CreateChannelHandler(chan, 0, StdinProc, (ClientData) isPtr);
sl@0:     code = Tcl_RecordAndEvalObj(interp, commandPtr, TCL_EVAL_GLOBAL);
sl@0:     isPtr->input = chan = Tcl_GetStdChannel(TCL_STDIN);
sl@0:     Tcl_DecrRefCount(commandPtr);
sl@0:     isPtr->commandPtr = commandPtr = Tcl_NewObj();
sl@0:     Tcl_IncrRefCount(commandPtr);
sl@0:     if (chan != (Tcl_Channel) NULL) {
sl@0: 	Tcl_CreateChannelHandler(chan, TCL_READABLE, StdinProc,
sl@0: 		(ClientData) isPtr);
sl@0:     }
sl@0:     if (code != TCL_OK) {
sl@0: 	Tcl_Channel errChannel = Tcl_GetStdChannel(TCL_STDERR);
sl@0: 	if (errChannel != (Tcl_Channel) NULL) {
sl@0: 	    Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
sl@0: 	    Tcl_WriteChars(errChannel, "\n", 1);
sl@0: 	}
sl@0:     } else if (isPtr->tty) {
sl@0: 	Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
sl@0: 	Tcl_Channel outChannel = Tcl_GetStdChannel(TCL_STDOUT);
sl@0: 	Tcl_IncrRefCount(resultPtr);
sl@0: 	Tcl_GetStringFromObj(resultPtr, &length);
sl@0: 	if ((length >0) && (outChannel != (Tcl_Channel) NULL)) {
sl@0: 	    Tcl_WriteObj(outChannel, resultPtr);
sl@0: 	    Tcl_WriteChars(outChannel, "\n", 1);
sl@0: 	}
sl@0: 	Tcl_DecrRefCount(resultPtr);
sl@0:     }
sl@0: 
sl@0:     /*
sl@0:      * If a tty stdin is still around, output a prompt.
sl@0:      */
sl@0: 
sl@0:     prompt:
sl@0:     if (isPtr->tty && (isPtr->input != (Tcl_Channel) NULL)) {
sl@0: 	Prompt(interp, &(isPtr->prompt));
sl@0: 	isPtr->input = Tcl_GetStdChannel(TCL_STDIN);
sl@0:     }
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * Prompt --
sl@0:  *
sl@0:  *	Issue a prompt on standard output, or invoke a script
sl@0:  *	to issue the prompt.
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	A prompt gets output, and a Tcl script may be evaluated
sl@0:  *	in interp.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: static void
sl@0: Prompt(interp, promptPtr)
sl@0:     Tcl_Interp *interp;			/* Interpreter to use for prompting. */
sl@0:     PromptType *promptPtr;		/* Points to type of prompt to print.
sl@0: 					 * Filled with PROMPT_NONE after a
sl@0: 					 * prompt is printed. */
sl@0: {
sl@0:     Tcl_Obj *promptCmdPtr;
sl@0:     int code;
sl@0:     Tcl_Channel outChannel, errChannel;
sl@0: 
sl@0:     if (*promptPtr == PROMPT_NONE) {
sl@0: 	return;
sl@0:     }
sl@0: 
sl@0:     promptCmdPtr = Tcl_GetVar2Ex(interp,
sl@0: 	    ((*promptPtr == PROMPT_CONTINUE) ? "tcl_prompt2" : "tcl_prompt1"),
sl@0: 	    NULL, TCL_GLOBAL_ONLY);
sl@0:     if (Tcl_InterpDeleted(interp)) {
sl@0: 	return;
sl@0:     }
sl@0:     if (promptCmdPtr == NULL) {
sl@0: 	defaultPrompt:
sl@0: 	outChannel = Tcl_GetStdChannel(TCL_STDOUT);
sl@0: 	if ((*promptPtr == PROMPT_START)
sl@0: 		&& (outChannel != (Tcl_Channel) NULL)) {
sl@0: 	    Tcl_WriteChars(outChannel, "% ", 2);
sl@0: 	}
sl@0:     } else {
sl@0: 	code = Tcl_EvalObjEx(interp, promptCmdPtr, TCL_EVAL_GLOBAL);
sl@0: 	if (code != TCL_OK) {
sl@0: 	    Tcl_AddErrorInfo(interp,
sl@0: 		    "\n    (script that generates prompt)");
sl@0: 	    errChannel = Tcl_GetStdChannel(TCL_STDERR);
sl@0:             if (errChannel != (Tcl_Channel) NULL) {
sl@0:                 Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
sl@0:                 Tcl_WriteChars(errChannel, "\n", 1);
sl@0:             }
sl@0: 	    goto defaultPrompt;
sl@0: 	}
sl@0:     }
sl@0:     outChannel = Tcl_GetStdChannel(TCL_STDOUT);
sl@0:     if (outChannel != (Tcl_Channel) NULL) {
sl@0: 	Tcl_Flush(outChannel);
sl@0:     }
sl@0:     *promptPtr = PROMPT_NONE;
sl@0: }