diff options
Diffstat (limited to 'generic/tclMain.c')
| -rw-r--r-- | generic/tclMain.c | 260 |
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); + } +} |