* generic/tclStubInit.c:

	* generic/tclDecls.h:
	* generic/tcl.decls: added Tcl_SetMainLoop proc that allows people
	to set a main loop that will run for tclsh.
	* generic/tcl.h: added Tcl_MainLoopProc typedef
	* generic/tclMain.c (Tcl_SetMainLoop, StdinProc, Prompt): new
	StdinProc and Prompt static procs and Tcl_SetMainLoop stubs proc.
	The first two handle a fileevent based prompt (taken from
	tkMain.c).  Tcl_SetMainLoop enables the interactive setting of a
	main loop procedure.  This enables Tk to be a loadable package.

1 files changed, 252 insertions, 8 deletions

diff --git a/generic/tclMain.c b/generic/tclMain.c
index 6e846c7..5089a93 100644
--- a/generic/tclMain.c
+++ b/generic/tclMain.c
@@ -5,11 +5,12 @@
  *
  * Copyright (c) 1988-1994 The Regents of the University of California.
  * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 2000 Ajuba Solutions.
  *
  * 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.7 1999/12/12 02:26:42 hobbs Exp $
+ * RCS: @(#) $Id: tclMain.c,v 1.8 2000/11/03 18:46:12 hobbs Exp $
  */
 
 #include "tcl.h"
@@ -42,7 +43,27 @@ extern char *		strcpy _ANSI_ARGS_((char *dst, CONST char *src));
 
 static char *tclStartupScriptFileName = NULL;
 
+static Tcl_MainLoopProc *mainLoopProc = NULL;
 
+typedef struct ThreadSpecificData {
+    Tcl_Interp *interp;         /* Interpreter for this thread. */
+    Tcl_DString command;        /* Used to assemble lines of terminal input
+				 * into Tcl commands. */
+    Tcl_DString line;           /* Used to read the next line from the
+				 * terminal input. */
+    int tty;                    /* Non-zero means standard input is a 
+				 * terminal-like device.  Zero means it's
+				 * a file. */
+} ThreadSpecificData;
+Tcl_ThreadDataKey dataKey;
+
+/*
+ * 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));
 
 
 /*
@@ -101,7 +122,7 @@ char *TclGetStartupScriptFileName()
  *
  * Results:
  *	None. This procedure never returns (it exits the process when
- *	it's done.
+ *	it's done).
  *
  * Side effects:
  *	This procedure initializes the Tcl world and then starts
@@ -124,14 +145,18 @@ Tcl_Main(argc, argv, appInitProc)
     Tcl_Obj *resultPtr;
     Tcl_Obj *commandPtr = NULL;
     char buffer[1000], *args;
-    int code, gotPartial, tty, length;
+    int code, gotPartial, length;
     int exitCode = 0;
     Tcl_Channel inChannel, outChannel, errChannel;
     Tcl_Interp *interp;
     Tcl_DString argString;
+    ThreadSpecificData *tsdPtr;
+
+    tsdPtr = (ThreadSpecificData *) 
+	Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
 
     Tcl_FindExecutable(argv[0]);
-    interp = Tcl_CreateInterp();
+    tsdPtr->interp = interp = Tcl_CreateInterp();
 #ifdef TCL_MEM_DEBUG
     Tcl_InitMemory(interp);
 #endif
@@ -170,9 +195,9 @@ Tcl_Main(argc, argv, appInitProc)
      * Set the "tcl_interactive" variable.
      */
 
-    tty = isatty(0);
+    tsdPtr->tty = isatty(0);
     Tcl_SetVar(interp, "tcl_interactive",
-	    ((tclStartupScriptFileName == NULL) && tty) ? "1" : "0",
+	    ((tclStartupScriptFileName == NULL) && tsdPtr->tty) ? "1" : "0",
 	    TCL_GLOBAL_ONLY);
     
     /*
@@ -235,7 +260,7 @@ Tcl_Main(argc, argv, appInitProc)
     outChannel = Tcl_GetStdChannel(TCL_STDOUT);
     gotPartial = 0;
     while (1) {
-	if (tty) {
+	if (tsdPtr->tty) {
 	    Tcl_Obj *promptCmdPtr;
 
 	    promptCmdPtr = Tcl_GetVar2Ex(interp,
@@ -299,7 +324,7 @@ Tcl_Main(argc, argv, appInitProc)
 		Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
 		Tcl_WriteChars(errChannel, "\n", 1);
 	    }
-	} else if (tty) {
+	} else if (tsdPtr->tty) {
 	    resultPtr = Tcl_GetObjResult(interp);
 	    Tcl_GetStringFromObj(resultPtr, &length);
 	    if ((length > 0) && outChannel) {
@@ -307,6 +332,27 @@ Tcl_Main(argc, argv, appInitProc)
 		Tcl_WriteChars(outChannel, "\n", 1);
 	    }
 	}
+	if (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.
+	     */
+
+	    if (inChannel) {
+		Tcl_CreateChannelHandler(inChannel, TCL_READABLE, StdinProc,
+			(ClientData) inChannel);
+	    }
+	    if (tsdPtr->tty) {
+		Prompt(interp, 0);
+	    }
+	    Tcl_DStringInit(&tsdPtr->command);
+	    Tcl_DStringInit(&tsdPtr->line);
+
+	    mainLoopProc();
+	    mainLoopProc = NULL;
+	    break;
+	}
 #ifdef TCL_MEM_DEBUG
 	if (tclMemDumpFileName != NULL) {
 	    Tcl_DecrRefCount(commandPtr);
@@ -323,9 +369,207 @@ Tcl_Main(argc, argv, appInitProc)
      */
 
     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();
+    }
     if (commandPtr != NULL) {
 	Tcl_DecrRefCount(commandPtr);
     }
     sprintf(buffer, "exit %d", exitCode);
     Tcl_Eval(interp, buffer);
 }
+
+/*
+ *---------------------------------------------------------------
+ *
+ * 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.
+ *
+ *---------------------------------------------------------------
+ */
+
+void
+Tcl_SetMainLoop(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;		/* Not used. */
+    int mask;				/* Not used. */
+{
+    static int gotPartial = 0;
+    char *cmd;
+    int code, count;
+    Tcl_Channel chan = (Tcl_Channel) clientData;
+    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
+            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+    Tcl_Interp *interp = tsdPtr->interp;
+
+    count = Tcl_Gets(chan, &tsdPtr->line);
+
+    if (count < 0) {
+	if (!gotPartial) {
+	    if (tsdPtr->tty) {
+		Tcl_Exit(0);
+	    } else {
+		Tcl_DeleteChannelHandler(chan, StdinProc, (ClientData) chan);
+	    }
+	    return;
+	} 
+    }
+
+    (void) Tcl_DStringAppend(&tsdPtr->command, Tcl_DStringValue(
+            &tsdPtr->line), -1);
+    cmd = Tcl_DStringAppend(&tsdPtr->command, "\n", -1);
+    Tcl_DStringFree(&tsdPtr->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);
+    code = Tcl_RecordAndEval(interp, cmd, TCL_EVAL_GLOBAL);
+    
+    chan = Tcl_GetStdChannel(TCL_STDIN);
+    if (chan) {
+	Tcl_CreateChannelHandler(chan, TCL_READABLE, StdinProc,
+		(ClientData) chan);
+    }
+    Tcl_DStringFree(&tsdPtr->command);
+    if (Tcl_GetStringResult(interp)[0] != '\0') {
+	if ((code != TCL_OK) || (tsdPtr->tty)) {
+	    chan = Tcl_GetStdChannel(TCL_STDOUT);
+	    if (chan) {
+		Tcl_WriteObj(chan, Tcl_GetObjResult(interp));
+		Tcl_WriteChars(chan, "\n", 1);
+	    }
+	}
+    }
+
+    /*
+     * Output a prompt.
+     */
+
+    prompt:
+    if (tsdPtr->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(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;
+    Tcl_Channel outChannel, errChannel;
+
+    promptCmd = Tcl_GetVar(interp,
+	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_WriteChars(outChannel, "% ", 2);
+            }
+	}
+    } 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_WriteObj(errChannel, Tcl_GetObjResult(interp));
+                Tcl_WriteChars(errChannel, "\n", 1);
+            }
+	    goto defaultPrompt;
+	}
+    }
+    outChannel = Tcl_GetChannel(interp, "stdout", NULL);
+    if (outChannel != (Tcl_Channel) NULL) {
+	Tcl_Flush(outChannel);
+    }
+}