#include "tcl.h"
#include "tclInt.h"
# undef TCL_STORAGE_CLASS
# define TCL_STORAGE_CLASS DLLEXPORT
#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;
typedef enum {
PROMPT_NONE,
PROMPT_START,
PROMPT_CONTINUE
} PromptType;
typedef struct InteractiveState {
Tcl_Channel input;
int tty;
Tcl_Obj *commandPtr;
PromptType prompt;
Tcl_Interp *interp;
} InteractiveState;
static void Prompt _ANSI_ARGS_((Tcl_Interp *interp,
PromptType *promptPtr));
static void StdinProc _ANSI_ARGS_((ClientData clientData,
int mask));
void TclSetStartupScriptPath(pathPtr)
Tcl_Obj *pathPtr;
{
if (tclStartupScriptPath != NULL) {
Tcl_DecrRefCount(tclStartupScriptPath);
}
tclStartupScriptPath = pathPtr;
if (tclStartupScriptPath != NULL) {
Tcl_IncrRefCount(tclStartupScriptPath);
}
}
Tcl_Obj *TclGetStartupScriptPath()
{
return tclStartupScriptPath;
}
void TclSetStartupScriptFileName(fileName)
CONST char *fileName;
{
Tcl_Obj *pathPtr = Tcl_NewStringObj(fileName,-1);
TclSetStartupScriptPath(pathPtr);
}
CONST char *TclGetStartupScriptFileName()
{
Tcl_Obj *pathPtr = TclGetStartupScriptPath();
if (pathPtr == NULL) {
return NULL;
}
return Tcl_GetString(pathPtr);
}
void
Tcl_Main(argc, argv, appInitProc)
int argc;
char **argv;
Tcl_AppInitProc *appInitProc;
{
Tcl_Obj *resultPtr;
Tcl_Obj *commandPtr = NULL;
char buffer[TCL_INTEGER_SPACE + 5], *args;
PromptType prompt = PROMPT_START;
int code, length, tty;
int exitCode = 0;
Tcl_Channel inChannel, outChannel, errChannel;
Tcl_Interp *interp;
Tcl_DString argString;
Tcl_FindExecutable(argv[0]);
interp = Tcl_CreateInterp();
Tcl_InitMemory(interp);
if (TclGetStartupScriptPath() == NULL) {
if ((argc > 1) && (argv[1][0] != '-')) {
TclSetStartupScriptFileName(argv[1]);
argc--;
argv++;
}
}
args = Tcl_Merge(argc-1, (CONST char **)argv+1);
Tcl_ExternalToUtfDString(NULL, args, -1, &argString);
Tcl_SetVar(interp, "argv", Tcl_DStringValue(&argString), TCL_GLOBAL_ONLY);
Tcl_DStringFree(&argString);
ckfree(args);
if (TclGetStartupScriptPath() == NULL) {
Tcl_ExternalToUtfDString(NULL, argv[0], -1, &argString);
} else {
TclSetStartupScriptFileName(Tcl_ExternalToUtfDString(NULL,
TclGetStartupScriptFileName(), -1, &argString));
}
TclFormatInt(buffer, (long) argc-1);
Tcl_SetVar(interp, "argc", buffer, TCL_GLOBAL_ONLY);
Tcl_SetVar(interp, "argv0", Tcl_DStringValue(&argString), TCL_GLOBAL_ONLY);
tty = isatty(0);
Tcl_SetVar(interp, "tcl_interactive",
((TclGetStartupScriptPath() == NULL) && tty) ? "1" : "0",
TCL_GLOBAL_ONLY);
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 (TclGetStartupScriptPath() != NULL) {
code = Tcl_FSEvalFile(interp, TclGetStartupScriptPath());
if (code != TCL_OK) {
errChannel = Tcl_GetStdChannel(TCL_STDERR);
if (errChannel) {
Tcl_AddErrorInfo(interp, "");
Tcl_WriteObj(errChannel, Tcl_GetVar2Ex(interp, "errorInfo",
NULL, TCL_GLOBAL_ONLY));
Tcl_WriteChars(errChannel, "\n", 1);
}
exitCode = 1;
}
goto done;
}
Tcl_DStringFree(&argString);
Tcl_SourceRCFile(interp);
commandPtr = Tcl_NewObj();
Tcl_IncrRefCount(commandPtr);
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 (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)) {
continue;
}
break;
}
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);
}
if (mainLoopProc != NULL) {
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
if (tclMemDumpFileName != NULL) {
mainLoopProc = NULL;
Tcl_DeleteInterp(interp);
}
#endif
}
done:
if ((exitCode == 0) && (mainLoopProc != NULL)) {
(*mainLoopProc)();
mainLoopProc = NULL;
}
if (commandPtr != NULL) {
Tcl_DecrRefCount(commandPtr);
}
if (!Tcl_InterpDeleted(interp)) {
sprintf(buffer, "exit %d", exitCode);
Tcl_Eval(interp, buffer);
if (!Tcl_InterpDeleted(interp)) {
Tcl_DeleteInterp(interp);
}
}
TclSetStartupScriptPath(NULL);
Tcl_Release((ClientData) interp);
Tcl_Exit(exitCode);
}
void
Tcl_SetMainLoop(proc)
Tcl_MainLoopProc *proc;
{
mainLoopProc = proc;
}
static void
StdinProc(clientData, mask)
ClientData clientData;
int mask;
{
InteractiveState *isPtr = (InteractiveState *) clientData;
Tcl_Channel chan = isPtr->input;
Tcl_Obj *commandPtr = isPtr->commandPtr;
Tcl_Interp *interp = isPtr->interp;
int code, length;
if (Tcl_IsShared(commandPtr)) {
Tcl_DecrRefCount(commandPtr);
commandPtr = Tcl_DuplicateObj(commandPtr);
Tcl_IncrRefCount(commandPtr);
}
length = Tcl_GetsObj(chan, commandPtr);
if (length < 0) {
if (Tcl_InputBlocked(chan)) {
return;
}
if (isPtr->tty) {
Tcl_Exit(0);
}
Tcl_DeleteChannelHandler(chan, StdinProc, (ClientData) isPtr);
return;
}
if (Tcl_IsShared(commandPtr)) {
Tcl_DecrRefCount(commandPtr);
commandPtr = Tcl_DuplicateObj(commandPtr);
Tcl_IncrRefCount(commandPtr);
}
Tcl_AppendToObj(commandPtr, "\n", 1);
if (!TclObjCommandComplete(commandPtr)) {
isPtr->prompt = PROMPT_CONTINUE;
goto prompt;
}
isPtr->prompt = PROMPT_START;
Tcl_CreateChannelHandler(chan, 0, StdinProc, (ClientData) isPtr);
code = Tcl_RecordAndEvalObj(interp, commandPtr, TCL_EVAL_GLOBAL);
isPtr->input = chan = Tcl_GetStdChannel(TCL_STDIN);
Tcl_DecrRefCount(commandPtr);
isPtr->commandPtr = commandPtr = Tcl_NewObj();
Tcl_IncrRefCount(commandPtr);
if (chan != (Tcl_Channel) NULL) {
Tcl_CreateChannelHandler(chan, TCL_READABLE, StdinProc,
(ClientData) isPtr);
}
if (code != TCL_OK) {
Tcl_Channel errChannel = Tcl_GetStdChannel(TCL_STDERR);
if (errChannel != (Tcl_Channel) NULL) {
Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
Tcl_WriteChars(errChannel, "\n", 1);
}
} else if (isPtr->tty) {
Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
Tcl_Channel outChannel = Tcl_GetStdChannel(TCL_STDOUT);
Tcl_IncrRefCount(resultPtr);
Tcl_GetStringFromObj(resultPtr, &length);
if ((length >0) && (outChannel != (Tcl_Channel) NULL)) {
Tcl_WriteObj(outChannel, resultPtr);
Tcl_WriteChars(outChannel, "\n", 1);
}
Tcl_DecrRefCount(resultPtr);
}
prompt:
if (isPtr->tty && (isPtr->input != (Tcl_Channel) NULL)) {
Prompt(interp, &(isPtr->prompt));
isPtr->input = Tcl_GetStdChannel(TCL_STDIN);
}
}
static void
Prompt(interp, promptPtr)
Tcl_Interp *interp;
PromptType *promptPtr;
{
Tcl_Obj *promptCmdPtr;
int code;
Tcl_Channel outChannel, errChannel;
if (*promptPtr == PROMPT_NONE) {
return;
}
promptCmdPtr = Tcl_GetVar2Ex(interp,
((*promptPtr == PROMPT_CONTINUE) ? "tcl_prompt2" : "tcl_prompt1"),
NULL, TCL_GLOBAL_ONLY);
if (Tcl_InterpDeleted(interp)) {
return;
}
if (promptCmdPtr == NULL) {
defaultPrompt:
outChannel = Tcl_GetStdChannel(TCL_STDOUT);
if ((*promptPtr == PROMPT_START)
&& (outChannel != (Tcl_Channel) NULL)) {
Tcl_WriteChars(outChannel, "% ", 2);
}
} else {
code = Tcl_EvalObjEx(interp, promptCmdPtr, TCL_EVAL_GLOBAL);
if (code != TCL_OK) {
Tcl_AddErrorInfo(interp,
"\n (script that generates prompt)");
errChannel = Tcl_GetStdChannel(TCL_STDERR);
if (errChannel != (Tcl_Channel) NULL) {
Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
Tcl_WriteChars(errChannel, "\n", 1);
}
goto defaultPrompt;
}
}
outChannel = Tcl_GetStdChannel(TCL_STDOUT);
if (outChannel != (Tcl_Channel) NULL) {
Tcl_Flush(outChannel);
}
*promptPtr = PROMPT_NONE;
}