/* 
 * tclAppInit.c --
 *
 *	Provides a default version of the main program and Tcl_AppInit
 *	procedure for Tcl applications (without Tk).
 *
 * Copyright (c) 1993 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclAppInit.c,v 1.11 2002/05/31 22:20:22 dgp Exp $
 */

		

<Tcl copyright>

#include <tcl.h>
#include <errno.h>
#include <string.h>
#include <unistd.h>

int Tcl_AppInit(Tcl_Interp *interp);
<Communication variables between main and Tcl_AppInit>

/*
 *----------------------------------------------------------------------
 *
 * main --
 *
 *	This is the main program for the application.
 *
 * Results:
 *	None: Tcl_Main never returns here, so this procedure never
 *	returns either.
 *
 * Side effects:
 *	Whatever the application does.
 *
 *----------------------------------------------------------------------
 */

int main(int argc,char **argv) {
	<Wyrm wif shell parameters>
	Tcl_Main(nargc, nargv, Tcl_AppInit);
	return 0;			/* Needed only to prevent compiler warning. */
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AppInit --
 *
 *	This procedure performs application-specific initialization.
 *	Most applications, especially those that incorporate additional
 *	packages, will have their own version of this procedure.
 *
 * Results:
 *	Returns a standard Tcl completion code, and leaves an error
 *	message in the interp's result if an error occurs.
 *
 * Side effects:
 *	Depends on the startup script.
 *
 *----------------------------------------------------------------------
 */

int Tcl_AppInit(Tcl_Interp *interp) {
	if (Tcl_Init(interp) == TCL_ERROR) {
		return TCL_ERROR;
	}
	<Load the wyrmwif environment>
	<Run command line sources and commands>
	Tcl_SetVar(interp, "tcl_rcFileName", "~/.tclshrc", TCL_GLOBAL_ONLY);
	return TCL_OK;
}

		

static int oargc; static char **oargv;

		

#define streq(x,y) (strcmp(x,y)==0)
int nargc = 1; char **nargv = (char**)Tcl_Alloc((argc+2)*sizeof(char*));
int keepstdin = 0;
int batch = 0;
int command = 0;
int alternateinput = 0;
oargc = argc-1; oargv = argv+1;
argc--;
nargv[0] = *argv++;
while (argc>0) {
	if (streq(*argv,"-i")) {
		argc -= 1; argv += 1;
		keepstdin = 1;
	}else if (streq(*argv,"-n")) {
		argc -= 1; argv += 1;
		batch = 1;
	}else if (argc>1 && streq(*argv,"-s")) {
		argc -= 2; argv += 2;
	}else if (argc>1 && streq(*argv,"-c")) {
		argc -= 2; argv += 2;
		command = 1;
	}else if (argc>1 && streq(*argv,"-p")) {
		argc -= 2; argv += 2;
	}else if (streq(*argv,"--")) {
		argc -= 1; argv += 1;
		while (argc>0) {
			if (nargc==1) alternateinput = !streq(*argv,"-");
			nargv[nargc++] = *argv++; argc--;
		}
	}else {
		if (nargc==1) alternateinput = !streq(*argv,"-");
		nargv[nargc++] = *argv++; argc--;
	}
}
<stdin>
nargv[nargc] = 0;

		

if (batch) keepstdin = 0;
if (!command && !batch) keepstdin = 1;
if (!keepstdin && !alternateinput) {
	if (nargc==1) nargc = 2;
	nargv[1] = "/dev/null";
}

		

int p;
if (Tcl_VarEval(interp,"package require wyrmwif",0)!=TCL_OK) {
	static char msg[] = "require wyrmwif: ";
	char *result = Tcl_GetStringResult(interp);
	write(2,msg,sizeof(msg)-1);
	write(2,result,strlen(result));
	write(2,"\n",1);
	return TCL_ERROR;
}
for (p=0; p<oargc; p++) {
	if (p+1<oargc && streq(oargv[p],"-s")) {
		p++;
	}else if (p+1<oargc && streq(oargv[p],"-c")) {
		p++;
	}else if (p+1<oargc && streq(oargv[p],"-p")) {
		if (Tcl_VarEval(interp,"package require wyrm",oargv[p+1],0)!=TCL_OK) {
			static char msg1[] = "require wyrm";
			static char msg2[] = ": ";
			char *result = Tcl_GetStringResult(interp);
			write(2,msg1,sizeof(msg1)-1);
			write(2,oargv[p+1],strlen(oargv[p+1]));
			write(2,msg2,sizeof(msg2)-1);
			write(2,result,strlen(result));
			write(2,"\n",1);
			return TCL_ERROR;
		}
		p++;
	}else if (streq(oargv[p],"--")) {
		break;
	}
}
Tcl_VarEval(interp,"wyrm::mc -load [lindex $env(TCLLIBPATH) 0]/wyrmwif.msgs",0);
if (Tcl_VarEval(interp,"namespace import wyrm::*",0)!=TCL_OK) {
	static char msg[] = "import wyrmwif: ";
	char *result = Tcl_GetStringResult(interp);
	write(2,msg,sizeof(msg)-1);
	write(2,result,strlen(result));
	write(2,"\n",1);
	return TCL_ERROR;
}

		

while (oargc>0) {
	if (oargc>1 && streq(*oargv,"-s")) {
		int rc = Tcl_EvalFile(interp,oargv[1]);
		if (rc!=TCL_OK) {
			static char msg1[] = "-s ";
			static char msg2[] = ": error: ";
			char *result = Tcl_GetStringResult(interp);
			write(2,msg1,sizeof(msg1)-1);
			write(2,oargv[1],strlen(oargv[1]));
			write(2,msg2,sizeof(msg2)-1);
			write(2,result,strlen(result));
			write(2,"\n",1);
			return TCL_ERROR;
		}
		oargc -= 2; oargv += 2;
	}else if (oargc>1 && streq(*oargv,"-c")) {
		int rc = Tcl_Eval(interp,oargv[1]);
		char *result = Tcl_GetStringResult(interp);
		if (rc==TCL_OK) {
			write(1,result,strlen(result));
			write(1,"\n",1);
		}else {
			static char msg[] = ": error: ";
			char *result = Tcl_GetStringResult(interp);
			write(2,oargv[1],strlen(oargv[1]));
			write(2,msg,sizeof(msg)-1);
			write(2,result,strlen(result));
			write(2,"\n",1);
			return TCL_ERROR;
		}
		oargc -= 2; oargv += 2;
	}else if (oargc>1 && streq(*oargv,"-p")) {
		oargc -= 2; oargv += 2;
	}else if (streq(*oargv,"--")) {
		oargc = 0;
	}else {
		oargv++; oargc--;
	}
}