#include "tcl.h"
#include "tclInt.h"
# undef TCL_STORAGE_CLASS
# define TCL_STORAGE_CLASS DLLEXPORT
EXTERN int Tcl_LinkVar();
int (*tclDummyLinkVarPtr)() = Tcl_LinkVar;
extern int isatty _ANSI_ARGS_((int fd));
extern char * strcpy _ANSI_ARGS_((char *dst, CONST char *src));
static Tcl_Interp *interp;
#ifdef TCL_MEM_DEBUG
static char dumpFile[100];
static int quitFlag = 0;
#endif
#ifdef TCL_MEM_DEBUG
static int CheckmemCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char *argv[]));
#endif
void
Tcl_Main(argc, argv, appInitProc)
int argc;
char **argv;
Tcl_AppInitProc *appInitProc;
{
Tcl_Obj *prompt1NamePtr = NULL;
Tcl_Obj *prompt2NamePtr = NULL;
Tcl_Obj *resultPtr;
Tcl_Obj *commandPtr = NULL;
char buffer[1000], *args, *fileName, *bytes;
int code, gotPartial, tty, length;
int exitCode = 0;
Tcl_Channel inChannel, outChannel, errChannel;
Tcl_FindExecutable(argv[0]);
interp = Tcl_CreateInterp();
#ifdef TCL_MEM_DEBUG
Tcl_InitMemory(interp);
Tcl_CreateCommand(interp, "checkmem", CheckmemCmd, (ClientData) 0,
(Tcl_CmdDeleteProc *) NULL);
#endif
fileName = NULL;
if ((argc > 1) && (argv[1][0] != '-')) {
fileName = argv[1];
argc--;
argv++;
}
args = Tcl_Merge(argc-1, argv+1);
Tcl_SetVar(interp, "argv", args, TCL_GLOBAL_ONLY);
ckfree(args);
TclFormatInt(buffer, argc-1);
Tcl_SetVar(interp, "argc", buffer, TCL_GLOBAL_ONLY);
Tcl_SetVar(interp, "argv0", (fileName != NULL) ? fileName : argv[0],
TCL_GLOBAL_ONLY);
tty = isatty(0);
Tcl_SetVar(interp, "tcl_interactive",
((fileName == NULL) && tty) ? "1" : "0", TCL_GLOBAL_ONLY);
if ((*appInitProc)(interp) != TCL_OK) {
errChannel = Tcl_GetStdChannel(TCL_STDERR);
if (errChannel) {
Tcl_Write(errChannel,
"application-specific initialization failed: ", -1);
Tcl_Write(errChannel, interp->result, -1);
Tcl_Write(errChannel, "\n", 1);
}
}
if (fileName != NULL) {
code = Tcl_EvalFile(interp, fileName);
if (code != TCL_OK) {
errChannel = Tcl_GetStdChannel(TCL_STDERR);
if (errChannel) {
Tcl_AddErrorInfo(interp, "");
Tcl_Write(errChannel,
Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY), -1);
Tcl_Write(errChannel, "\n", 1);
}
exitCode = 1;
}
goto done;
}
Tcl_SourceRCFile(interp);
commandPtr = Tcl_NewObj();
Tcl_IncrRefCount(commandPtr);
prompt1NamePtr = Tcl_NewStringObj("tcl_prompt1", -1);
Tcl_IncrRefCount(prompt1NamePtr);
prompt2NamePtr = Tcl_NewStringObj("tcl_prompt2", -1);
Tcl_IncrRefCount(prompt2NamePtr);
inChannel = Tcl_GetStdChannel(TCL_STDIN);
outChannel = Tcl_GetStdChannel(TCL_STDOUT);
gotPartial = 0;
while (1) {
if (tty) {
Tcl_Obj *promptCmdPtr;
promptCmdPtr = Tcl_ObjGetVar2(interp,
(gotPartial? prompt2NamePtr : prompt1NamePtr),
(Tcl_Obj *) NULL, TCL_GLOBAL_ONLY);
if (promptCmdPtr == NULL) {
defaultPrompt:
if (!gotPartial && outChannel) {
Tcl_Write(outChannel, "% ", 2);
}
} else {
code = Tcl_EvalObj(interp, promptCmdPtr);
inChannel = Tcl_GetStdChannel(TCL_STDIN);
outChannel = Tcl_GetStdChannel(TCL_STDOUT);
errChannel = Tcl_GetStdChannel(TCL_STDERR);
if (code != TCL_OK) {
if (errChannel) {
resultPtr = Tcl_GetObjResult(interp);
bytes = Tcl_GetStringFromObj(resultPtr, &length);
Tcl_Write(errChannel, bytes, length);
Tcl_Write(errChannel, "\n", 1);
}
Tcl_AddErrorInfo(interp,
"\n (script that generates prompt)");
goto defaultPrompt;
}
}
if (outChannel) {
Tcl_Flush(outChannel);
}
}
if (!inChannel) {
goto done;
}
length = Tcl_GetsObj(inChannel, commandPtr);
if (length < 0) {
goto done;
}
if ((length == 0) && Tcl_Eof(inChannel) && (!gotPartial)) {
goto done;
}
Tcl_AppendToObj(commandPtr, "\n", 1);
if (!TclObjCommandComplete(commandPtr)) {
gotPartial = 1;
continue;
}
gotPartial = 0;
code = Tcl_RecordAndEvalObj(interp, commandPtr, 0);
inChannel = Tcl_GetStdChannel(TCL_STDIN);
outChannel = Tcl_GetStdChannel(TCL_STDOUT);
errChannel = Tcl_GetStdChannel(TCL_STDERR);
Tcl_SetObjLength(commandPtr, 0);
if (code != TCL_OK) {
if (errChannel) {
resultPtr = Tcl_GetObjResult(interp);
bytes = Tcl_GetStringFromObj(resultPtr, &length);
Tcl_Write(errChannel, bytes, length);
Tcl_Write(errChannel, "\n", 1);
}
} else if (tty) {
resultPtr = Tcl_GetObjResult(interp);
bytes = Tcl_GetStringFromObj(resultPtr, &length);
if ((length > 0) && outChannel) {
Tcl_Write(outChannel, bytes, length);
Tcl_Write(outChannel, "\n", 1);
}
}
#ifdef TCL_MEM_DEBUG
if (quitFlag) {
Tcl_DecrRefCount(commandPtr);
Tcl_DecrRefCount(prompt1NamePtr);
Tcl_DecrRefCount(prompt2NamePtr);
Tcl_DeleteInterp(interp);
Tcl_Exit(0);
}
#endif
}
done:
if (commandPtr != NULL) {
Tcl_DecrRefCount(commandPtr);
}
if (prompt1NamePtr != NULL) {
Tcl_DecrRefCount(prompt1NamePtr);
}
if (prompt2NamePtr != NULL) {
Tcl_DecrRefCount(prompt2NamePtr);
}
sprintf(buffer, "exit %d", exitCode);
Tcl_Eval(interp, buffer);
}
#ifdef TCL_MEM_DEBUG
static int
CheckmemCmd(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char *argv[];
{
extern char *tclMemDumpFileName;
if (argc != 2) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
" fileName\"", (char *) NULL);
return TCL_ERROR;
}
strcpy(dumpFile, argv[1]);
tclMemDumpFileName = dumpFile;
quitFlag = 1;
return TCL_OK;
}
#endif