/* 
 * Tcl command -- provide a Tcl CLI-command with awk-like command syntax
 *
 * Copyright 1990 Hackercorp
 * Permission to use, copy, modify, and distribute this
 * software and its documentation for any purpose and without
 * fee is hereby granted, provided that the above copyright
 * notice appear in all copies.  Hackercorp makes no 
 * representations about the suitability of this software for 
 * any purpose.  It is provided "as is" without express or 
 * implied warranty.
 *
 * usage:
 *
 *  tcl [-f tcl_source_filename] [-p portname] [args...]
 *
 *  tcl command [args...]
 *
 *  tcl
 */

#include <stdlib.h>
#include <functions.h>
#include <tcl.h>
#include <tcla.h>

struct TclaBase *TclaBase = NULL;

#define ABORT_TEXT "program aborted\n"
#define LIBRARY_TEXT "unable to open tcla.library"

void _abort(void)
{
	if (TclaBase != (struct TclaBase *)NULL)
		CloseLibrary(TclaBase);
	Write(Output(),ABORT_TEXT,sizeof(ABORT_TEXT));
	exit(1);
}

void
print_result(int returnval, char *result_text)
{
	BPTR Out = Output();

	if (returnval == TCL_OK) {
	    if (*result_text != 0) {
			Write(Out, result_text, strlen(result_text));
			Write(Out, "\n", 1);
	    }
	} else {
	    if (returnval == TCL_ERROR) {
			Write(Out, "Error", 5);
	    } else {
			Write(Out, "Error (and bad return)", 22);
	    }
	    if (*result_text != 0) {
			Write(Out, ": ", 2);
			Write(Out, result_text, strlen(result_text));
		}
		Write(Out, "\n", 1);
	}
}

usage()
{
	print_result(TCL_ERROR, "usage: tcl [-f filename] [-p portname] [args..]");
	_abort();
}

int 
main(int argc, char **argv)
{
	Tcl_Interp *interp;
	int result;
	char *inputfile = NULL;
	char *command = NULL;
	char *portname = NULL;
	int argsleft, nextarg;
	struct TclaHeader *TclaHead;

	if ((TclaBase = OpenLibrary("tcla.library", 0L)) == 0) 
	{
		Write(Output(),LIBRARY_TEXT,sizeof(LIBRARY_TEXT));
		exit(1);
	}

    interp = Tcl_CreateInterp();

	/* set up the Tcl argv variable to an empty string
	 *
	/* if no arguments, give the user a Tcl command prompt 
	 * 
	 * if there's a "-f" followed by something, that's a filename
	 * for Tcl to load
	 *
	 * if there's a "-p" followed by something, that's a portname
	 * for Tcl to use instead of it's argv[0] (program name)
	 *
	 * if no "-f" was specified and there is at least one argument
	 * besides the "-p", the first argument is a command to be
	 * evaluated by Tcl and the remaining arguments, if any, are
	 * set up as the global varibale argv
	 *
	 * if there are arguments left over after any "-f filename," they
	 * are merged into the argv variable in the same manner
	 */

	/* set the argv to null so it'll be there even if we don't have
	 * any args, which is desirable */
	Tcl_SetVar(interp, "argv", "", 1);

	/* argsleft = all but program name (argv[0]), next arg is 1 */
	argsleft = argc - 1;
	nextarg = 1;

	while (argsleft > 0)
	{

		if (strcmp(argv[nextarg],"-f") == 0)
		{
			if (argsleft < 2)
				usage();

			inputfile = argv[nextarg+1];
			nextarg += 2;
			argsleft -= 2;
		}
		else if (strcmp(argv[nextarg],"-p") == 0)
		{
			if (argsleft < 2)
				usage();

			portname = argv[nextarg+1];
			nextarg += 2;
			argsleft -= 2;
		}
		else
		{	
			/* if we don't have an input file, the next arg is the command*/
			if (inputfile == NULL)
			{
				command = argv[nextarg++];
				argsleft--;
			}

			/* if there are any args left, they are destined for the argv */
			if (argsleft > 0)
			{
				char *args;
				args = Tcl_Merge(argsleft, &argv[nextarg]);
				Tcl_SetVar(interp, "argv", args, 1);
				ckfree(args);
				argsleft = 0;
			}
		}
	}

	TclaHead = Tcla_Init(interp, argv[0], portname);
	Tcla_CleanupRoutine(TclaHead, _abort);	/* call this if Tcla panics */

	/* if they specified a file, source it */
	if (inputfile)
	{
		char s[80];
		strcpy(s,"source ");
		strcat(s,inputfile);
		result = Tcl_Eval(interp, s, 0, NULL);
		print_result(result, interp->result);
	}
	else if (command)	/* else if they specified a command, evaluate it */
	{
		result = Tcl_Eval(interp, command, 0, NULL);
		print_result(result, interp->result);
	}
	else	/* else source startup.tcl and run the command loop */
	{
		Tcl_Eval(interp, "source tclprocs:startup.tcl", 0, NULL);
		Tcl_Eval(interp, "commandloop", 0, NULL);
	}

	/* cleanup and exit */
	Tcl_DeleteInterp(interp);
	CloseLibrary(TclaBase);
	exit(0);
}