os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/generic/tclMain.c
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/generic/tclMain.c Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,755 @@
1.4 +/*
1.5 + * tclMain.c --
1.6 + *
1.7 + * Main program for Tcl shells and other Tcl-based applications.
1.8 + *
1.9 + * Copyright (c) 1988-1994 The Regents of the University of California.
1.10 + * Copyright (c) 1994-1997 Sun Microsystems, Inc.
1.11 + * Copyright (c) 2000 Ajuba Solutions.
1.12 + * Portions Copyright (c) 2007-2008 Nokia Corporation and/or its subsidiaries. All rights reserved.
1.13 + *
1.14 + * See the file "license.terms" for information on usage and redistribution
1.15 + * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
1.16 + *
1.17 + * RCS: @(#) $Id: tclMain.c,v 1.20.2.3 2006/05/05 18:08:58 dgp Exp $
1.18 + */
1.19 +
1.20 +#include "tcl.h"
1.21 +#include "tclInt.h"
1.22 +#if defined(__SYMBIAN32__)
1.23 +#include "tclPort.h"
1.24 +#include "tclSymbianGlobals.h"
1.25 +#include "tclIntPlatDecls.h"
1.26 +#endif
1.27 +
1.28 +# undef TCL_STORAGE_CLASS
1.29 +# define TCL_STORAGE_CLASS DLLEXPORT
1.30 +
1.31 +/*
1.32 + * Declarations for various library procedures and variables (don't want
1.33 + * to include tclPort.h here, because people might copy this file out of
1.34 + * the Tcl source directory to make their own modified versions).
1.35 + */
1.36 +
1.37 +#if !defined(MAC_TCL)
1.38 +# if !defined(__SYMBIAN32__)
1.39 +extern int isatty _ANSI_ARGS_((int fd));
1.40 +# endif
1.41 +#else
1.42 +#include <unistd.h>
1.43 +#endif
1.44 +
1.45 +static Tcl_Obj *tclStartupScriptPath = NULL;
1.46 +
1.47 +static Tcl_MainLoopProc *mainLoopProc = NULL;
1.48 +
1.49 +/*
1.50 + * Structure definition for information used to keep the state of
1.51 + * an interactive command processor that reads lines from standard
1.52 + * input and writes prompts and results to standard output.
1.53 + */
1.54 +
1.55 +typedef enum {
1.56 + PROMPT_NONE, /* Print no prompt */
1.57 + PROMPT_START, /* Print prompt for command start */
1.58 + PROMPT_CONTINUE /* Print prompt for command continuation */
1.59 +} PromptType;
1.60 +
1.61 +typedef struct InteractiveState {
1.62 + Tcl_Channel input; /* The standard input channel from which
1.63 + * lines are read. */
1.64 + int tty; /* Non-zero means standard input is a
1.65 + * terminal-like device. Zero means it's
1.66 + * a file. */
1.67 + Tcl_Obj *commandPtr; /* Used to assemble lines of input into
1.68 + * Tcl commands. */
1.69 + PromptType prompt; /* Next prompt to print */
1.70 + Tcl_Interp *interp; /* Interpreter that evaluates interactive
1.71 + * commands. */
1.72 +} InteractiveState;
1.73 +
1.74 +/*
1.75 + * Forward declarations for procedures defined later in this file.
1.76 + */
1.77 +
1.78 +static void Prompt _ANSI_ARGS_((Tcl_Interp *interp,
1.79 + PromptType *promptPtr));
1.80 +static void StdinProc _ANSI_ARGS_((ClientData clientData,
1.81 + int mask));
1.82 +/*
1.83 + *----------------------------------------------------------------------
1.84 + *
1.85 + * TclSetStartupScriptPath --
1.86 + *
1.87 + * Primes the startup script VFS path, used to override the
1.88 + * command line processing.
1.89 + *
1.90 + * Results:
1.91 + * None.
1.92 + *
1.93 + * Side effects:
1.94 + * This procedure initializes the VFS path of the Tcl script to
1.95 + * run at startup.
1.96 + *
1.97 + *----------------------------------------------------------------------
1.98 + */
1.99 +void TclSetStartupScriptPath(pathPtr)
1.100 + Tcl_Obj *pathPtr;
1.101 +{
1.102 + if (tclStartupScriptPath != NULL) {
1.103 + Tcl_DecrRefCount(tclStartupScriptPath);
1.104 + }
1.105 + tclStartupScriptPath = pathPtr;
1.106 + if (tclStartupScriptPath != NULL) {
1.107 + Tcl_IncrRefCount(tclStartupScriptPath);
1.108 + }
1.109 +}
1.110 +
1.111 +
1.112 +/*
1.113 + *----------------------------------------------------------------------
1.114 + *
1.115 + * TclGetStartupScriptPath --
1.116 + *
1.117 + * Gets the startup script VFS path, used to override the
1.118 + * command line processing.
1.119 + *
1.120 + * Results:
1.121 + * The startup script VFS path, NULL if none has been set.
1.122 + *
1.123 + * Side effects:
1.124 + * None.
1.125 + *
1.126 + *----------------------------------------------------------------------
1.127 + */
1.128 +Tcl_Obj *TclGetStartupScriptPath()
1.129 +{
1.130 + return tclStartupScriptPath;
1.131 +}
1.132 +
1.133 +
1.134 +/*
1.135 + *----------------------------------------------------------------------
1.136 + *
1.137 + * TclSetStartupScriptFileName --
1.138 + *
1.139 + * Primes the startup script file name, used to override the
1.140 + * command line processing.
1.141 + *
1.142 + * Results:
1.143 + * None.
1.144 + *
1.145 + * Side effects:
1.146 + * This procedure initializes the file name of the Tcl script to
1.147 + * run at startup.
1.148 + *
1.149 + *----------------------------------------------------------------------
1.150 + */
1.151 +void TclSetStartupScriptFileName(fileName)
1.152 + CONST char *fileName;
1.153 +{
1.154 + Tcl_Obj *pathPtr = Tcl_NewStringObj(fileName,-1);
1.155 + TclSetStartupScriptPath(pathPtr);
1.156 +}
1.157 +
1.158 +
1.159 +/*
1.160 + *----------------------------------------------------------------------
1.161 + *
1.162 + * TclGetStartupScriptFileName --
1.163 + *
1.164 + * Gets the startup script file name, used to override the
1.165 + * command line processing.
1.166 + *
1.167 + * Results:
1.168 + * The startup script file name, NULL if none has been set.
1.169 + *
1.170 + * Side effects:
1.171 + * None.
1.172 + *
1.173 + *----------------------------------------------------------------------
1.174 + */
1.175 +CONST char *TclGetStartupScriptFileName()
1.176 +{
1.177 + Tcl_Obj *pathPtr = TclGetStartupScriptPath();
1.178 +
1.179 + if (pathPtr == NULL) {
1.180 + return NULL;
1.181 + }
1.182 + return Tcl_GetString(pathPtr);
1.183 +}
1.184 +
1.185 +
1.186 +
1.187 +/*
1.188 + *----------------------------------------------------------------------
1.189 + *
1.190 + * Tcl_Main --
1.191 + *
1.192 + * Main program for tclsh and most other Tcl-based applications.
1.193 + *
1.194 + * Results:
1.195 + * None. This procedure never returns (it exits the process when
1.196 + * it's done).
1.197 + *
1.198 + * Side effects:
1.199 + * This procedure initializes the Tcl world and then starts
1.200 + * interpreting commands; almost anything could happen, depending
1.201 + * on the script being interpreted.
1.202 + *
1.203 + *----------------------------------------------------------------------
1.204 + */
1.205 +
1.206 +void
1.207 +Tcl_Main(argc, argv, appInitProc)
1.208 + int argc; /* Number of arguments. */
1.209 + char **argv; /* Array of argument strings. */
1.210 + Tcl_AppInitProc *appInitProc;
1.211 + /* Application-specific initialization
1.212 + * procedure to call after most
1.213 + * initialization but before starting to
1.214 + * execute commands. */
1.215 +{
1.216 + Tcl_Obj *resultPtr, *argvPtr, *commandPtr = NULL;
1.217 + PromptType prompt = PROMPT_START;
1.218 + int code, length, tty, exitCode = 0;
1.219 + Tcl_Channel inChannel, outChannel, errChannel;
1.220 + Tcl_Interp *interp;
1.221 + Tcl_DString appName;
1.222 + Tcl_Obj *objPtr;
1.223 +
1.224 +#if defined(__SYMBIAN32__)
1.225 + int isChildProcess = 0;
1.226 + int oldArgc = 0;
1.227 +#endif
1.228 + Tcl_FindExecutable(argv[0]);
1.229 + interp = Tcl_CreateInterp();
1.230 +
1.231 +#if defined(__SYMBIAN32__)
1.232 + if (ChildProcessInit(&argc, &argv))
1.233 + {
1.234 + oldArgc = argc;
1.235 + argc = argc-4;
1.236 + isChildProcess = 1;
1.237 + }
1.238 + #endif
1.239 +
1.240 + Tcl_InitMemory(interp);
1.241 +
1.242 + /*
1.243 + * Make command-line arguments available in the Tcl variables "argc"
1.244 + * and "argv". If the first argument doesn't start with a "-" then
1.245 + * strip it off and use it as the name of a script file to process.
1.246 + */
1.247 +
1.248 + if (TclGetStartupScriptPath() == NULL) {
1.249 + if ((argc > 1) && (argv[1][0] != '-')) {
1.250 + TclSetStartupScriptFileName(argv[1]);
1.251 + argc--;
1.252 + argv++;
1.253 + }
1.254 + }
1.255 +
1.256 + if (TclGetStartupScriptPath() == NULL) {
1.257 + Tcl_ExternalToUtfDString(NULL, argv[0], -1, &appName);
1.258 + } else {
1.259 + TclSetStartupScriptFileName(Tcl_ExternalToUtfDString(NULL,
1.260 + TclGetStartupScriptFileName(), -1, &appName));
1.261 + }
1.262 + Tcl_SetVar(interp, "argv0", Tcl_DStringValue(&appName), TCL_GLOBAL_ONLY);
1.263 + Tcl_DStringFree(&appName);
1.264 + argc--;
1.265 + argv++;
1.266 +
1.267 + objPtr = Tcl_NewIntObj(argc);
1.268 + Tcl_IncrRefCount(objPtr);
1.269 + Tcl_SetVar2Ex(interp, "argc", NULL, objPtr, TCL_GLOBAL_ONLY);
1.270 + Tcl_DecrRefCount(objPtr);
1.271 +
1.272 + argvPtr = Tcl_NewListObj(0, NULL);
1.273 + while (argc--) {
1.274 + Tcl_DString ds;
1.275 + Tcl_ExternalToUtfDString(NULL, *argv++, -1, &ds);
1.276 + Tcl_ListObjAppendElement(NULL, argvPtr, Tcl_NewStringObj(
1.277 + Tcl_DStringValue(&ds), Tcl_DStringLength(&ds)));
1.278 + Tcl_DStringFree(&ds);
1.279 + }
1.280 + Tcl_IncrRefCount(argvPtr);
1.281 + Tcl_SetVar2Ex(interp, "argv", NULL, argvPtr, TCL_GLOBAL_ONLY);
1.282 + Tcl_DecrRefCount(argvPtr);
1.283 +
1.284 + /*
1.285 + * Set the "tcl_interactive" variable.
1.286 + */
1.287 +
1.288 + tty = isatty(0);
1.289 + Tcl_SetVar(interp, "tcl_interactive",
1.290 + ((TclGetStartupScriptPath() == NULL) && tty) ? "1" : "0",
1.291 + TCL_GLOBAL_ONLY);
1.292 +
1.293 + /*
1.294 + * Invoke application-specific initialization.
1.295 + */
1.296 +
1.297 + Tcl_Preserve((ClientData) interp);
1.298 + if ((*appInitProc)(interp) != TCL_OK) {
1.299 + errChannel = Tcl_GetStdChannel(TCL_STDERR);
1.300 + if (errChannel) {
1.301 + Tcl_WriteChars(errChannel,
1.302 + "application-specific initialization failed: ", -1);
1.303 + Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
1.304 + Tcl_WriteChars(errChannel, "\n", 1);
1.305 + }
1.306 + }
1.307 + if (Tcl_InterpDeleted(interp)) {
1.308 + goto done;
1.309 + }
1.310 +
1.311 + /*
1.312 + * If a script file was specified then just source that file
1.313 + * and quit.
1.314 + */
1.315 +
1.316 + if (TclGetStartupScriptPath() != NULL) {
1.317 + code = Tcl_FSEvalFile(interp, TclGetStartupScriptPath());
1.318 + if (code != TCL_OK) {
1.319 + errChannel = Tcl_GetStdChannel(TCL_STDERR);
1.320 + if (errChannel) {
1.321 +
1.322 + /*
1.323 + * The following statement guarantees that the errorInfo
1.324 + * variable is set properly.
1.325 + */
1.326 +
1.327 + Tcl_AddErrorInfo(interp, "");
1.328 + Tcl_WriteObj(errChannel, Tcl_GetVar2Ex(interp, "errorInfo",
1.329 + NULL, TCL_GLOBAL_ONLY));
1.330 + Tcl_WriteChars(errChannel, "\n", 1);
1.331 + }
1.332 + exitCode = 1;
1.333 + }
1.334 + goto done;
1.335 + }
1.336 +
1.337 + /*
1.338 + * We're running interactively. Source a user-specific startup
1.339 + * file if the application specified one and if the file exists.
1.340 + */
1.341 +
1.342 + Tcl_SourceRCFile(interp);
1.343 +
1.344 + /*
1.345 + * Process commands from stdin until there's an end-of-file. Note
1.346 + * that we need to fetch the standard channels again after every
1.347 + * eval, since they may have been changed.
1.348 + */
1.349 +
1.350 + commandPtr = Tcl_NewObj();
1.351 + Tcl_IncrRefCount(commandPtr);
1.352 +
1.353 + /*
1.354 + * Get a new value for tty if anyone writes to ::tcl_interactive
1.355 + */
1.356 + Tcl_LinkVar(interp, "tcl_interactive", (char *) &tty, TCL_LINK_BOOLEAN);
1.357 + inChannel = Tcl_GetStdChannel(TCL_STDIN);
1.358 + outChannel = Tcl_GetStdChannel(TCL_STDOUT);
1.359 + while ((inChannel != (Tcl_Channel) NULL) && !Tcl_InterpDeleted(interp)) {
1.360 + if (mainLoopProc == NULL) {
1.361 + if (tty) {
1.362 + Prompt(interp, &prompt);
1.363 + if (Tcl_InterpDeleted(interp)) {
1.364 + break;
1.365 + }
1.366 + inChannel = Tcl_GetStdChannel(TCL_STDIN);
1.367 + if (inChannel == (Tcl_Channel) NULL) {
1.368 + break;
1.369 + }
1.370 + }
1.371 + if (Tcl_IsShared(commandPtr)) {
1.372 + Tcl_DecrRefCount(commandPtr);
1.373 + commandPtr = Tcl_DuplicateObj(commandPtr);
1.374 + Tcl_IncrRefCount(commandPtr);
1.375 + }
1.376 + length = Tcl_GetsObj(inChannel, commandPtr);
1.377 + if (length < 0) {
1.378 + if (Tcl_InputBlocked(inChannel)) {
1.379 +
1.380 + /*
1.381 + * This can only happen if stdin has been set to
1.382 + * non-blocking. In that case cycle back and try
1.383 + * again. This sets up a tight polling loop (since
1.384 + * we have no event loop running). If this causes
1.385 + * bad CPU hogging, we might try toggling the blocking
1.386 + * on stdin instead.
1.387 + */
1.388 +
1.389 + continue;
1.390 + }
1.391 +
1.392 + /*
1.393 + * Either EOF, or an error on stdin; we're done
1.394 + */
1.395 +
1.396 + break;
1.397 + }
1.398 +
1.399 + /*
1.400 + * Add the newline removed by Tcl_GetsObj back to the string.
1.401 + */
1.402 +
1.403 + if (Tcl_IsShared(commandPtr)) {
1.404 + Tcl_DecrRefCount(commandPtr);
1.405 + commandPtr = Tcl_DuplicateObj(commandPtr);
1.406 + Tcl_IncrRefCount(commandPtr);
1.407 + }
1.408 + Tcl_AppendToObj(commandPtr, "\n", 1);
1.409 + if (!TclObjCommandComplete(commandPtr)) {
1.410 + prompt = PROMPT_CONTINUE;
1.411 + continue;
1.412 + }
1.413 +
1.414 + prompt = PROMPT_START;
1.415 + code = Tcl_RecordAndEvalObj(interp, commandPtr, TCL_EVAL_GLOBAL);
1.416 + inChannel = Tcl_GetStdChannel(TCL_STDIN);
1.417 + outChannel = Tcl_GetStdChannel(TCL_STDOUT);
1.418 + errChannel = Tcl_GetStdChannel(TCL_STDERR);
1.419 + Tcl_DecrRefCount(commandPtr);
1.420 + commandPtr = Tcl_NewObj();
1.421 + Tcl_IncrRefCount(commandPtr);
1.422 + if (code != TCL_OK) {
1.423 + if (errChannel) {
1.424 + Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
1.425 + Tcl_WriteChars(errChannel, "\n", 1);
1.426 + }
1.427 + } else if (tty) {
1.428 + resultPtr = Tcl_GetObjResult(interp);
1.429 + Tcl_IncrRefCount(resultPtr);
1.430 + Tcl_GetStringFromObj(resultPtr, &length);
1.431 + if ((length > 0) && outChannel) {
1.432 + Tcl_WriteObj(outChannel, resultPtr);
1.433 + Tcl_WriteChars(outChannel, "\n", 1);
1.434 + }
1.435 + Tcl_DecrRefCount(resultPtr);
1.436 + }
1.437 + } else { /* (mainLoopProc != NULL) */
1.438 + /*
1.439 + * If a main loop has been defined while running interactively,
1.440 + * we want to start a fileevent based prompt by establishing a
1.441 + * channel handler for stdin.
1.442 + */
1.443 +
1.444 + InteractiveState *isPtr = NULL;
1.445 +
1.446 + if (inChannel) {
1.447 + if (tty) {
1.448 + Prompt(interp, &prompt);
1.449 + }
1.450 + isPtr = (InteractiveState *)
1.451 + ckalloc((int) sizeof(InteractiveState));
1.452 + isPtr->input = inChannel;
1.453 + isPtr->tty = tty;
1.454 + isPtr->commandPtr = commandPtr;
1.455 + isPtr->prompt = prompt;
1.456 + isPtr->interp = interp;
1.457 +
1.458 + Tcl_UnlinkVar(interp, "tcl_interactive");
1.459 + Tcl_LinkVar(interp, "tcl_interactive", (char *) &(isPtr->tty),
1.460 + TCL_LINK_BOOLEAN);
1.461 +
1.462 + Tcl_CreateChannelHandler(inChannel, TCL_READABLE, StdinProc,
1.463 + (ClientData) isPtr);
1.464 + }
1.465 +
1.466 + (*mainLoopProc)();
1.467 + mainLoopProc = NULL;
1.468 +
1.469 + if (inChannel) {
1.470 + tty = isPtr->tty;
1.471 + Tcl_UnlinkVar(interp, "tcl_interactive");
1.472 + Tcl_LinkVar(interp, "tcl_interactive", (char *) &tty,
1.473 + TCL_LINK_BOOLEAN);
1.474 + prompt = isPtr->prompt;
1.475 + commandPtr = isPtr->commandPtr;
1.476 + if (isPtr->input != (Tcl_Channel) NULL) {
1.477 + Tcl_DeleteChannelHandler(isPtr->input, StdinProc,
1.478 + (ClientData) isPtr);
1.479 + }
1.480 + ckfree((char *)isPtr);
1.481 + }
1.482 + inChannel = Tcl_GetStdChannel(TCL_STDIN);
1.483 + outChannel = Tcl_GetStdChannel(TCL_STDOUT);
1.484 + errChannel = Tcl_GetStdChannel(TCL_STDERR);
1.485 + }
1.486 +#ifdef TCL_MEM_DEBUG
1.487 +
1.488 + /*
1.489 + * This code here only for the (unsupported and deprecated)
1.490 + * [checkmem] command.
1.491 + */
1.492 +
1.493 + if (tclMemDumpFileName != NULL) {
1.494 + mainLoopProc = NULL;
1.495 + Tcl_DeleteInterp(interp);
1.496 + }
1.497 +#endif
1.498 + }
1.499 +
1.500 + done:
1.501 + if ((exitCode == 0) && (mainLoopProc != NULL)) {
1.502 +
1.503 + /*
1.504 + * If everything has gone OK so far, call the main loop proc,
1.505 + * if it exists. Packages (like Tk) can set it to start processing
1.506 + * events at this point.
1.507 + */
1.508 +
1.509 + (*mainLoopProc)();
1.510 + mainLoopProc = NULL;
1.511 + }
1.512 + if (commandPtr != NULL) {
1.513 + Tcl_DecrRefCount(commandPtr);
1.514 + }
1.515 +
1.516 +#if defined(__SYMBIAN32__)
1.517 + ChildProcessCleanup(isChildProcess, oldArgc, argv);
1.518 +#else
1.519 + close (TCL_STDIN);
1.520 + close (TCL_STDOUT);
1.521 + close (TCL_STDERR); //every process has a error file
1.522 +#endif
1.523 +
1.524 + /*
1.525 + * Rather than calling exit, invoke the "exit" command so that
1.526 + * users can replace "exit" with some other command to do additional
1.527 + * cleanup on exit. The Tcl_Eval call should never return.
1.528 + */
1.529 +
1.530 + if (!Tcl_InterpDeleted(interp)) {
1.531 + char buffer[TCL_INTEGER_SPACE + 5];
1.532 + sprintf(buffer, "exit %d", exitCode);
1.533 + Tcl_Eval(interp, buffer);
1.534 +
1.535 + /*
1.536 + * If Tcl_Eval returns, trying to eval [exit], something
1.537 + * unusual is happening. Maybe interp has been deleted;
1.538 + * maybe [exit] was redefined. We still want to cleanup
1.539 + * and exit.
1.540 + */
1.541 +
1.542 + if (!Tcl_InterpDeleted(interp)) {
1.543 + Tcl_DeleteInterp(interp);
1.544 + }
1.545 + }
1.546 + TclSetStartupScriptPath(NULL);
1.547 +
1.548 + /*
1.549 + * If we get here, the master interp has been deleted. Allow
1.550 + * its destruction with the last matching Tcl_Release.
1.551 + */
1.552 +
1.553 + Tcl_Release((ClientData) interp);
1.554 + Tcl_Exit(exitCode);
1.555 +}
1.556 +
1.557 +/*
1.558 + *---------------------------------------------------------------
1.559 + *
1.560 + * Tcl_SetMainLoop --
1.561 + *
1.562 + * Sets an alternative main loop procedure.
1.563 + *
1.564 + * Results:
1.565 + * Returns the previously defined main loop procedure.
1.566 + *
1.567 + * Side effects:
1.568 + * This procedure will be called before Tcl exits, allowing for
1.569 + * the creation of an event loop.
1.570 + *
1.571 + *---------------------------------------------------------------
1.572 + */
1.573 +
1.574 +EXPORT_C void
1.575 +Tcl_SetMainLoop(proc)
1.576 + Tcl_MainLoopProc *proc;
1.577 +{
1.578 + mainLoopProc = proc;
1.579 +}
1.580 +
1.581 +/*
1.582 + *----------------------------------------------------------------------
1.583 + *
1.584 + * StdinProc --
1.585 + *
1.586 + * This procedure is invoked by the event dispatcher whenever
1.587 + * standard input becomes readable. It grabs the next line of
1.588 + * input characters, adds them to a command being assembled, and
1.589 + * executes the command if it's complete.
1.590 + *
1.591 + * Results:
1.592 + * None.
1.593 + *
1.594 + * Side effects:
1.595 + * Could be almost arbitrary, depending on the command that's
1.596 + * typed.
1.597 + *
1.598 + *----------------------------------------------------------------------
1.599 + */
1.600 +
1.601 + /* ARGSUSED */
1.602 +static void
1.603 +StdinProc(clientData, mask)
1.604 + ClientData clientData; /* The state of interactive cmd line */
1.605 + int mask; /* Not used. */
1.606 +{
1.607 + InteractiveState *isPtr = (InteractiveState *) clientData;
1.608 + Tcl_Channel chan = isPtr->input;
1.609 + Tcl_Obj *commandPtr = isPtr->commandPtr;
1.610 + Tcl_Interp *interp = isPtr->interp;
1.611 + int code, length;
1.612 +
1.613 + if (Tcl_IsShared(commandPtr)) {
1.614 + Tcl_DecrRefCount(commandPtr);
1.615 + commandPtr = Tcl_DuplicateObj(commandPtr);
1.616 + Tcl_IncrRefCount(commandPtr);
1.617 + }
1.618 + length = Tcl_GetsObj(chan, commandPtr);
1.619 + if (length < 0) {
1.620 + if (Tcl_InputBlocked(chan)) {
1.621 + return;
1.622 + }
1.623 + if (isPtr->tty) {
1.624 + /*
1.625 + * Would be better to find a way to exit the mainLoop?
1.626 + * Or perhaps evaluate [exit]? Leaving as is for now due
1.627 + * to compatibility concerns.
1.628 + */
1.629 + Tcl_Exit(0);
1.630 + }
1.631 + Tcl_DeleteChannelHandler(chan, StdinProc, (ClientData) isPtr);
1.632 + return;
1.633 + }
1.634 +
1.635 + if (Tcl_IsShared(commandPtr)) {
1.636 + Tcl_DecrRefCount(commandPtr);
1.637 + commandPtr = Tcl_DuplicateObj(commandPtr);
1.638 + Tcl_IncrRefCount(commandPtr);
1.639 + }
1.640 + Tcl_AppendToObj(commandPtr, "\n", 1);
1.641 + if (!TclObjCommandComplete(commandPtr)) {
1.642 + isPtr->prompt = PROMPT_CONTINUE;
1.643 + goto prompt;
1.644 + }
1.645 + isPtr->prompt = PROMPT_START;
1.646 +
1.647 + /*
1.648 + * Disable the stdin channel handler while evaluating the command;
1.649 + * otherwise if the command re-enters the event loop we might
1.650 + * process commands from stdin before the current command is
1.651 + * finished. Among other things, this will trash the text of the
1.652 + * command being evaluated.
1.653 + */
1.654 +
1.655 + Tcl_CreateChannelHandler(chan, 0, StdinProc, (ClientData) isPtr);
1.656 + code = Tcl_RecordAndEvalObj(interp, commandPtr, TCL_EVAL_GLOBAL);
1.657 + isPtr->input = chan = Tcl_GetStdChannel(TCL_STDIN);
1.658 + Tcl_DecrRefCount(commandPtr);
1.659 + isPtr->commandPtr = commandPtr = Tcl_NewObj();
1.660 + Tcl_IncrRefCount(commandPtr);
1.661 + if (chan != (Tcl_Channel) NULL) {
1.662 + Tcl_CreateChannelHandler(chan, TCL_READABLE, StdinProc,
1.663 + (ClientData) isPtr);
1.664 + }
1.665 + if (code != TCL_OK) {
1.666 + Tcl_Channel errChannel = Tcl_GetStdChannel(TCL_STDERR);
1.667 + if (errChannel != (Tcl_Channel) NULL) {
1.668 + Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
1.669 + Tcl_WriteChars(errChannel, "\n", 1);
1.670 + }
1.671 + } else if (isPtr->tty) {
1.672 + Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
1.673 + Tcl_Channel outChannel = Tcl_GetStdChannel(TCL_STDOUT);
1.674 + Tcl_IncrRefCount(resultPtr);
1.675 + Tcl_GetStringFromObj(resultPtr, &length);
1.676 + if ((length >0) && (outChannel != (Tcl_Channel) NULL)) {
1.677 + Tcl_WriteObj(outChannel, resultPtr);
1.678 + Tcl_WriteChars(outChannel, "\n", 1);
1.679 + }
1.680 + Tcl_DecrRefCount(resultPtr);
1.681 + }
1.682 +
1.683 + /*
1.684 + * If a tty stdin is still around, output a prompt.
1.685 + */
1.686 +
1.687 + prompt:
1.688 + if (isPtr->tty && (isPtr->input != (Tcl_Channel) NULL)) {
1.689 + Prompt(interp, &(isPtr->prompt));
1.690 + isPtr->input = Tcl_GetStdChannel(TCL_STDIN);
1.691 + }
1.692 +}
1.693 +
1.694 +/*
1.695 + *----------------------------------------------------------------------
1.696 + *
1.697 + * Prompt --
1.698 + *
1.699 + * Issue a prompt on standard output, or invoke a script
1.700 + * to issue the prompt.
1.701 + *
1.702 + * Results:
1.703 + * None.
1.704 + *
1.705 + * Side effects:
1.706 + * A prompt gets output, and a Tcl script may be evaluated
1.707 + * in interp.
1.708 + *
1.709 + *----------------------------------------------------------------------
1.710 + */
1.711 +
1.712 +static void
1.713 +Prompt(interp, promptPtr)
1.714 + Tcl_Interp *interp; /* Interpreter to use for prompting. */
1.715 + PromptType *promptPtr; /* Points to type of prompt to print.
1.716 + * Filled with PROMPT_NONE after a
1.717 + * prompt is printed. */
1.718 +{
1.719 + Tcl_Obj *promptCmdPtr;
1.720 + int code;
1.721 + Tcl_Channel outChannel, errChannel;
1.722 +
1.723 + if (*promptPtr == PROMPT_NONE) {
1.724 + return;
1.725 + }
1.726 +
1.727 + promptCmdPtr = Tcl_GetVar2Ex(interp,
1.728 + ((*promptPtr == PROMPT_CONTINUE) ? "tcl_prompt2" : "tcl_prompt1"),
1.729 + NULL, TCL_GLOBAL_ONLY);
1.730 + if (Tcl_InterpDeleted(interp)) {
1.731 + return;
1.732 + }
1.733 + if (promptCmdPtr == NULL) {
1.734 + defaultPrompt:
1.735 + outChannel = Tcl_GetStdChannel(TCL_STDOUT);
1.736 + if ((*promptPtr == PROMPT_START)
1.737 + && (outChannel != (Tcl_Channel) NULL)) {
1.738 + Tcl_WriteChars(outChannel, "% ", 2);
1.739 + }
1.740 + } else {
1.741 + code = Tcl_EvalObjEx(interp, promptCmdPtr, TCL_EVAL_GLOBAL);
1.742 + if (code != TCL_OK) {
1.743 + Tcl_AddErrorInfo(interp,
1.744 + "\n (script that generates prompt)");
1.745 + errChannel = Tcl_GetStdChannel(TCL_STDERR);
1.746 + if (errChannel != (Tcl_Channel) NULL) {
1.747 + Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
1.748 + Tcl_WriteChars(errChannel, "\n", 1);
1.749 + }
1.750 + goto defaultPrompt;
1.751 + }
1.752 + }
1.753 + outChannel = Tcl_GetStdChannel(TCL_STDOUT);
1.754 + if (outChannel != (Tcl_Channel) NULL) {
1.755 + Tcl_Flush(outChannel);
1.756 + }
1.757 + *promptPtr = PROMPT_NONE;
1.758 +}