/*
 * SCRIPTCMDS.C
 * (c) 1992-3 J.Harper
 */

#include "jed.h"
#include "jed_protos.h"

Prototype   VALUE *	cmd_script	(LONG, VALUE *);
Prototype   VALUE *	cmd_nargs	(LONG, VALUE *);
Prototype   VALUE *	cmd_arg		(LONG, VALUE *);
Prototype   VALUE *	cmd_if		(LONG, VALUE *);
Prototype   VALUE *	cmd_while	(LONG, VALUE *);
Prototype   VALUE *	cmd_select	(LONG, VALUE *);
Prototype   VALUE *	cmd_dowhile	(LONG, VALUE *);
Prototype   VALUE *	cmd_return	(LONG, VALUE *);
Prototype   VALUE *	cmd_break	(LONG, VALUE *);
Prototype   VALUE *	cmd_addsym	(LONG, VALUE *);
Prototype   VALUE *	cmd_remsym	(LONG, VALUE *);
Prototype   VALUE *	cmd_renamesym	(LONG, VALUE *);
Prototype   VALUE *	cmd_export	(LONG, VALUE *);
Prototype   VALUE *	cmd_type	(LONG, VALUE *);
Prototype   VALUE *	cmd_plus	(LONG, VALUE *);
Prototype   VALUE *	cmd_minus	(LONG, VALUE *);
Prototype   VALUE *	cmd_product	(LONG, VALUE *);
Prototype   VALUE *	cmd_divide	(LONG, VALUE *);
Prototype   VALUE *	cmd_mod		(LONG, VALUE *);
Prototype   VALUE *	cmd_b_not	(LONG, VALUE *);
Prototype   VALUE *	cmd_l_not	(LONG, VALUE *);
Prototype   VALUE *	cmd_b_or	(LONG, VALUE *);
Prototype   VALUE *	cmd_l_or	(LONG, VALUE *);
Prototype   VALUE *	cmd_b_and	(LONG, VALUE *);
Prototype   VALUE *	cmd_l_and	(LONG, VALUE *);
Prototype   VALUE *	cmd_b_eor	(LONG, VALUE *);
Prototype   VALUE *	cmd_l_eor	(LONG, VALUE *);
Prototype   VALUE *	cmd_lshift	(LONG, VALUE *);
Prototype   VALUE *	cmd_rshift	(LONG, VALUE *);
Prototype   VALUE *	cmd_equals	(LONG, VALUE *);
Prototype   VALUE *	cmd_equality	(LONG, VALUE *);
Prototype   VALUE *	cmd_inequality	(LONG, VALUE *);
Prototype   VALUE *	cmd_gtthan	(LONG, VALUE *);
Prototype   VALUE *	cmd_ltthan	(LONG, VALUE *);
Prototype   VALUE *	cmd_gethan	(LONG, VALUE *);
Prototype   VALUE *	cmd_lethan	(LONG, VALUE *);
Prototype   VALUE *	cmd_nop		(LONG, VALUE *);

/*
 * (script `sectType')
 * (script `x' `file')  - x stands for external (f is a section type)
 */
VALUE *
cmd_script(LONG argc, VALUE *argv)
{
    if(TPLATE2(VTF_STRING, VTF_ANY))
    {
	if(*(ARG1.val_Value.String) == 'x')
	{
	    if(ARG2.val_Type == VTF_STRING)
	    {
		STRPTR file;
		if(!(file = squirrelfile(ARG2.val_Value.String)))
		{
		    UBYTE othername[200];
		    strcpy(othername, "s:jed/");
		    AddPart(othername, ARG2.val_Value.String, 200);
		    file = squirrelfile(othername);
		}
		if(file)
		{
		    if(!execstr(file, &RES, FALSE, 0, NULL))
		    {
			freestring(file);
			return(FALSE);
		    }
		    freestring(file);
		}
		else
		    doserror();
	    }
	    else
		settitle("syntax error: argument 2 should be a string.");
	}
	else if(*(ARG1.val_Value.String) == 's')
	{
	    if(ARG2.val_Type == VTF_STRING)
	    {
		if(!execstr(ARG2.val_Value.String, &RES, FALSE, 0, NULL))
		    return(FALSE);
	    }
	    else
		settitle("syntax error: argument 2 should be a string.");
	}
	else
	{
	    POS temp = CurrVW->vw_CursorPos;
	    POS endpos;
	    if(getsection(ARG1.val_Value.String, &endpos))
	    {
		POS startpos = CurrVW->vw_CursorPos;
		LONG length;
		STRPTR text;
		CurrVW->vw_CursorPos = temp;
		length = sectionlength(&startpos, &endpos);
		if(text = AllocVec(length + 1, 0L))
		{
		    copysection(&startpos, &endpos, text);
		    text[length] = 0;
		    if(!execstr(text, &RES, FALSE, 0, NULL))
		    {
			FreeVec(text);
			return(FALSE);
		    }
		    FreeVec(text);
		}
		else
		    settitle(NoMemMsg);
	    }
	}
    }
    return(&RES);
}

/*
 * returns the number of arguments passed to the innermost macro
 * (nargs)
 */
VALUE *
cmd_nargs(LONG argc, VALUE *argv)
{
    LONG xargc;
    VALUE *xargv;
    if(findsargs(&xargc, &xargv))
    {
	setnumres(xargc);
    }
    return(&RES);
}

/*
 * returns an argument (prompts for it if it wasn't given)
 * (arg n `type' [`prompt'])
 *
 * type defines the type of value required -- `s' = string, `n' = number.
 * `e' = either
 * if an argument of the proper type can't be got then the macro is
 * aborted.
 */
VALUE *
cmd_arg(LONG argc, VALUE *argv)
{
    VALUE *res = &RES;
    if(TPLATE2(VTF_NUMBER, VTF_STRING))
    {
	LONG xargc;
	VALUE *xargv;
	if(findsargs(&xargc, &xargv))
	{
	    LONG argnum = ARG1.val_Value.Number;
	    switch(*(ARG2.val_Value.String))
	    {
		case 'e':
		    dupvalue(&RES, &xargv[argnum]);
		    break;
		case 's':
		    STRPTR arg = NULL;
		    if(xargv[argnum].val_Type == VTF_STRING)
			dupvalue(&RES, &xargv[argnum]);
		    else
		    {
			if(ARG3.val_Type == VTF_STRING)
			    arg = docmdline(ARG3.val_Value.String);
			else
			    arg = docmdline("string> ");
			if(argc)
			{
			    setstrres(arg);
			}
		    }
		    break;
		case 'n':
		    STRPTR str;
		    if(xargv[argnum].val_Type == VTF_NUMBER)
			dupvalue(&RES, &xargv[argnum]);
		    else
		    {
			if(ARG3.val_Type == VTF_STRING)
			    str = docmdline(ARG3.val_Value.String);
			else
			    str = docmdline("number> ");
			if(str)
			{
			    if(isdigit(*str) || (*str == '-'))
			    {
				APTR dummy;
				setnumres(strtol(str, &dummy, 0));
			    }
			    freestring(str);
			}
		    }
		    break;
	    }
	    if(RES.val_Type == VTF_NONE)
	    {
		settitlefmt("syntax error: no arg %ld provided", ARG1.val_Value.Number);
		res = FALSE;
	    }
	}
	else
	{
	    settitle("error: not in macro - can't use arg command");
	    res = FALSE;
	}
    }
    else
	res = FALSE;
    return(res);
}

/*
 * (if condition-clause `true-clause' `false-clause')
 *
 * result is value of evaluated clause.
 */
VALUE *
cmd_if(LONG argc, VALUE *argv)
{
    if(TPLATE3(VTF_NUMBER, VTF_ANY, VTF_ANY))
    {
	if(ARG1.val_Value.Number)
	{
	    if(ARG2.val_Type == VTF_STRING)
	    {
		if(!execstr(ARG2.val_Value.String, &RES, FALSE, 0, NULL))
		    return(FALSE);
	    }
	}
	else
	{
	    if(ARG3.val_Type == VTF_STRING)
	    {
		if(!execstr(ARG3.val_Value.String, &RES, FALSE, 0, NULL))
		    return(FALSE);
	    }
	}
    }
    return(&RES);
}

/*
 * (while `condition-clause' `true-clause')
 *
 * result is number of iterations before stopping.
 * loop will be broken after MAX_ITS number of iterations or a ^C break
 * signal is received.
 */
#define MAX_ITS (1000000)

VALUE *
cmd_while(LONG argc, VALUE *argv)
{
    if(TPLATE2(VTF_STRING, VTF_STRING))
    {
	LONG i;
	for(i = 0; i < MAX_ITS; i++)
	{
	    VALUE value;
	    if(!execstr(ARG1.val_Value.String, &value, FALSE, 0, NULL))
	    {
		releasevalue(&value);
		return(FALSE);
	    }
	    if(!value.val_Value.Number)
	    {
		releasevalue(&value);
		setnumres(i);
		return(&RES);
	    }
	    releasevalue(&value);
	    if(!execstr(ARG2.val_Value.String, &value, FALSE, 0, NULL))
	    {
		releasevalue(&value);
		return(FALSE);
	    }
	    releasevalue(&value);
	    if(CheckSignal(SIGBREAKF_CTRL_C))
	    {
		settitle("^C: while aborted");
		break;
	    }
	}
	if(i == MAX_ITS)
	    settitle("wow... a million iterations, while loop aborted");
    }
    return(FALSE);
}

/*
 *  (select
 *	(cond1)
 *	    `reaction1'
 *	(cond2)
 *	    `reaction2'
 *	...
 *	`default'
 *  )
 */
VALUE *
cmd_select(LONG argc, VALUE *argv)
{
    VALUE *res;
    WORD i;
    for(i = 0; i < argc; i += 2)
    {
	if((argv[i + 1].val_Type == VTF_NUMBER) && (argv[i + 2].val_Type == VTF_STRING))
	{
	    if(argv[i + 1].val_Value.Number)
		return(execstr(argv[i + 2].val_Value.String, &RES, FALSE, 0, NULL));
	}
	else if(argv[i + 1].val_Type == VTF_STRING)
	    return(execstr(argv[i + 1].val_Value.String, &RES, FALSE, 0, NULL));
    }
    return(&RES);
}

/*
 * (dowhile `command' `condition')
 *
 * similar to a C 'do...while' loop.
 */
VALUE *
cmd_dowhile(LONG argc, VALUE *argv)
{
    if(TPLATE2(VTF_STRING, VTF_STRING))
    {
	LONG i;
	for(i = 0; i < MAX_ITS; i++)
	{
	    VALUE value;
	    if(!execstr(ARG1.val_Value.String, &value, FALSE, 0, NULL))
	    {
		releasevalue(&value);
		return(FALSE);
	    }
	    releasevalue(&value);
	    if(!execstr(ARG2.val_Value.String, &value, FALSE, 0, NULL))
	    {
		releasevalue(&value);
		return(FALSE);
	    }
	    if(!value.val_Value.Number)
	    {
		releasevalue(&value);
		setnumres(i);
		return(&RES);
	    }
	    if(CheckSignal(SIGBREAKF_CTRL_C))
	    {
		settitle("^C: dowhile aborted");
		break;
	    }
	}
	if(i == MAX_ITS)
	    settitle("wow... a million iterations, dowhile loop aborted");
    }
    return(FALSE);
}

/*
 * breaks from the macro, returns ARG1
 */
VALUE *
cmd_return(LONG argc, VALUE *argv)
{
    dupvalue(&RES, &ARG1);
    return(FALSE);
}

/*
 * (break n)
 * Breaks out of n depths of strings that are currently being executed.
 */
VALUE *
cmd_break(LONG argc, VALUE *argv)
{
    RES.val_Type = VTF_BREAK;
    if(ARG1.val_Type == VTF_NUMBER)
    {
	if((RES.val_Value.Number = ARG1.val_Value.Number) <= 0)
	{
	    RES.val_Type = VTF_NONE;
	    return(&RES);
	}
    }
    else
	RES.val_Value.Number = 1;
    return(FALSE);
}

/*
 * (addsym {`sym-name' value symbol-type})
 *
 * symbol-type is,
 *  1 -- global command
 *  2 -- global variable
 *  3 -- local command
 *  4 -- local variable
 */
VALUE *
cmd_addsym(LONG argc, VALUE *argv)
{
    VALUE *res = &RES;
    BOOL rc = TRUE;
    while(rc && (argc >= 3))
    {
	if(TPLATE3(VTF_STRING, VTF_ANY, VTF_NUMBER))
	{
	    if(ARG3.val_Value.Number <= 2)
	    {
		if(!addgsym(ARG1.val_Value.String, ARG3.val_Value.Number, &ARG2))
		    rc = FALSE;
	    }
	    else
	    {
		if(!addlsym(ARG1.val_Value.String, ARG3.val_Value.Number - 2, &ARG2))
		    rc = FALSE;
	    }
	    if(!rc)
		settitlefmt("error: can't create variable %s", (LONG)ARG1.val_Value.String);
	}
	else
	    goto abort;
	argc -= 3;
	argv += 3;
    }
    res->val_Type = VTF_NUMBER;
    res->val_Value.Number = rc;
abort:
    return(res);
}

/*
 * (remsym {`sym-name'})
 *
 * note that if you want you can remove the primitive commands!
 */
VALUE *
cmd_remsym(LONG argc, VALUE *argv)
{
    VALUE *res = &RES;
    BOOL rc = TRUE;
    while(rc && (argc >= 1))
    {
	if(TPLATE1(VTF_STRING))
	{
	    if(!remsym(ARG1.val_Value.String))
	    {
		settitlefmt("error: can't remove symbol %s", (LONG)ARG1.val_Value.String);
		rc = FALSE;
	    }
	}
	else
	    goto abort;
	argc--;
	argv++;
    }
    res->val_Type = VTF_NUMBER;
    res->val_Value.Number = rc;
abort:
    return(res);
}

/*
 * (renamesym {`old-name' `new-name'})
 *
 * This can be used to rename primitive commands so that a macro can sit
 * on top of it.
 */
VALUE *
cmd_renamesym(LONG argc, VALUE *argv)
{
    VALUE *res = &RES;
    BOOL rc = TRUE;
    while(rc && (argc >= 2))
    {
	if(TPLATE2(VTF_STRING, VTF_STRING))
	{
	    GSYM *sym;
	    if(sym = findgsym(ARG1.val_Value.String))
	    {
		STRPTR newname;
		if(newname = savestring(ARG2.val_Value.String))
		{
		    removehash(SymbolTab, &sym->gs_Node, GSYMTABSIZE);
		    freestring(sym->gs_Node.h_Name);
		    sym->gs_Node.h_Name = newname;
		    inserthash(SymbolTab, &sym->gs_Node, GSYMTABSIZE);
		}
		else
		{
		    settitle(NoMemMsg);
		    rc = FALSE;
		}
	    }
	    else
	    {
		settitlefmt("error: no symbol %s", (LONG)ARG1.val_Value.String);
		rc = FALSE;
	    }
	}
	else
	    goto abort;
	argc -= 2;
	argv += 2;
    }
    res->val_Type = VTF_NUMBER;
    res->val_Value.Number = rc;
abort:
    return(res);
}

/*
 * (export {`lsym' how-far})
 *
 * moves lsym from its current depth to (current_depth - how_far)
 */
VALUE *
cmd_export(LONG argc, VALUE *argv)
{
    VALUE *res = &RES;
    BOOL rc = TRUE;
    while(rc && (argc >= 2))
    {
	if(TPLATE2(VTF_STRING, VTF_NUMBER))
	{
	    LSYM *ls = NULL;
	    WORD i;
	    for(i = CSDepth; !ls && i; i--)
	    {
		for(ls = (LSYM *)CSList[i].cs_Locals.lh_Head; ls->ls_Node.ln_Succ; ls = (LSYM *)ls->ls_Node.ln_Succ)
		{
		    if(!strcmp(ARG1.val_Value.String, ls->ls_Node.ln_Name))
			break;
		}
	    }
	    i -= ARG2.val_Value.Number;
	    if(ls && (i > 0))
	    {
		Remove(&ls->ls_Node);
		AddTail(&CSList[i].cs_Locals, &ls->ls_Node);
	    }
	    else
	    {
		settitlefmt("error: no local symbol %s", (LONG)ARG1.val_Value.String);
		rc = FALSE;
	    }
	}
	else
	    goto abort;
	argc -= 2;
	argv += 2;
    }
    res->val_Type = VTF_NUMBER;
    res->val_Value.Number = rc;
abort:
    return(res);
}

/*
 * (type <value>)
 */
VALUE *
cmd_type(LONG argc, VALUE *argv)
{
    setnumres(ARG1.val_Type);
    return(&RES);
}

/*
 * some arithmetic commands
 */

/* (+ 1 2) */
VALUE *
cmd_plus(LONG argc, VALUE *argv)
{
    setnumres(ARG1.val_Value.Number + ARG2.val_Value.Number);
    return(&RES);
}

/* (- 1 [2]) */
VALUE *
cmd_minus(LONG argc, VALUE *argv)
{
    if(argc == 1)
	setnumres(-(ARG1.val_Value.Number));
    else
	setnumres(ARG1.val_Value.Number - ARG2.val_Value.Number);
    return(&RES);
}

/* (* 1 2) */
VALUE *
cmd_product(LONG argc, VALUE *argv)
{
    setnumres(ARG1.val_Value.Number * ARG2.val_Value.Number);
    return(&RES);
}

/* (/ 1 2) */
VALUE *
cmd_divide(LONG argv, VALUE *argv)
{
    setnumres(ARG1.val_Value.Number / ARG2.val_Value.Number);
    return(&RES);
}

/* (% 1 2) */
VALUE *
cmd_mod(LONG argc, VALUE *argv)
{
    setnumres(ARG1.val_Value.Number % ARG2.val_Value.Number);
    return(&RES);
}

/* (~ 1) */
VALUE *
cmd_b_not(LONG argc, VALUE *argv)
{
    setnumres(~ARG1.val_Value.Number);
    return(&RES);
}

/* (! 1) */
VALUE *
cmd_l_not(LONG argc, VALUE *argv)
{
    setnumres(!ARG1.val_Value.Number);
    return(&RES);
}

/* (| 1 2) */
VALUE *
cmd_b_or(LONG argc, VALUE *argv)
{
    setnumres(ARG1.val_Value.Number | ARG2.val_Value.Number);
    return(&RES);
}

/* (|| 1 2) */
VALUE *
cmd_l_or(LONG argc, VALUE *argv)
{
    setnumres(ARG1.val_Value.Number || ARG2.val_Value.Number);
    return(&RES);
}

/* (& 1 2) */
VALUE *
cmd_b_and(LONG argc, VALUE *argv)
{
    setnumres(ARG1.val_Value.Number & ARG2.val_Value.Number);
    return(&RES);
}

/* (&& 1 2) */
VALUE *
cmd_l_and(LONG argc, VALUE *argv)
{
    setnumres(ARG1.val_Value.Number && ARG2.val_Value.Number);
    return(&RES);
}

/* (^ 1 2) */
VALUE *
cmd_b_eor(LONG argc, VALUE *argv)
{
    setnumres(ARG1.val_Value.Number ^ ARG2.val_Value.Number);
    return(&RES);
}

/* (^^ 1 2) */
VALUE *
cmd_l_eor(LONG argc, VALUE *argv)
{
    if(ARG1.val_Value.Number)
    {
	if(ARG2.val_Value.Number)
	    setnumres(FALSE);
	else
	    setnumres(TRUE);
    }
    else
	setnumres(TRUE);
    return(&RES);
}

/* (<< 1 2) */
VALUE *
cmd_lshift(LONG argc, VALUE *argv)
{
    setnumres(ARG1.val_Value.Number << ARG2.val_Value.Number);
    return(&RES);
}

/* (>> 1 2) */
VALUE *
cmd_rshift(LONG argc, VALUE *argv)
{
    setnumres(ARG1.val_Value.Number >> ARG2.val_Value.Number);
    return(&RES);
}

/*
 * (= `varname' value)
 */
VALUE *
cmd_equals(LONG argc, VALUE *argv)
{
    if(TPLATE2(VTF_STRING, VTF_ANY))
    {
	LSYM *lsym;
	GSYM *gsym;
	BOOL rc = TRUE;
	if(lsym = findlsym(ARG1.val_Value.String))
	{
	    releasevalue(&lsym->ls_Sym.sym_Value);
	    if(!dupvalue(&lsym->ls_Sym.sym_Value, &ARG2))
		rc = FALSE;
	}
	else if(gsym = findgsym(ARG1.val_Value.String))
	{
	    releasevalue(&gsym->gs_Sym.sym_Value);
	    if(!dupvalue(&gsym->gs_Sym.sym_Value, &ARG2))
		rc = FALSE;
	}
	else
	{
	    if(!addlsym(ARG1.val_Value.String, STF_VARIABLE, &ARG2))
		rc = FALSE;
	}
	if(!rc)
	    settitlefmt("error: can't set symbol %s", (LONG)ARG1.val_Value.String);
	setnumres(rc);
    }
    return(&RES);
}

/*
 * comparison operators
 */

/*
 * (== `string1' `STRING2')
 * (== 1 2)
 */
VALUE *
cmd_equality(LONG argc, VALUE *argv)
{
    if((ARG1.val_Type == VTF_STRING) && (ARG2.val_Type == VTF_STRING))
	setnumres(!stricmp(ARG1.val_Value.String, ARG2.val_Value.String));
    else if((ARG1.val_Type == VTF_NUMBER) && (ARG2.val_Type == VTF_NUMBER))
	setnumres(ARG1.val_Value.Number == ARG2.val_Value.Number);
    else
	settitle("syntax error: incorrect arguments to ==");
    return(&RES);
}

/*
 * (!= `string1' `STRING2')
 * (!= 1 2)
 */
VALUE *
cmd_inequality(LONG argc, VALUE *argv)
{
    if((ARG1.val_Type == VTF_STRING) && (ARG2.val_Type == VTF_STRING))
	setnumres(stricmp(ARG1.val_Value.String, ARG2.val_Value.String));
    else if((ARG1.val_Type == VTF_NUMBER) && (ARG2.val_Type == VTF_NUMBER))
	setnumres(ARG1.val_Value.String != ARG2.val_Value.String);
    else
	settitle("syntax error: incorrect arguments to !=");
    return(&RES);
}

/* (> 1 2) */
VALUE *
cmd_gtthan(LONG argc, VALUE *argv)
{
    setnumres(ARG1.val_Value.Number > ARG2.val_Value.Number);
    return(&RES);
}

/* (< 1 2) */
VALUE *
cmd_ltthan(LONG argc, VALUE *argv)
{
    setnumres(ARG1.val_Value.Number < ARG2.val_Value.Number);
    return(&RES);
}

/* (>= 1 2) */
VALUE *
cmd_gethan(LONG argc, VALUE *argv)
{
    setnumres(ARG1.val_Value.Number >= ARG2.val_Value.Number);
    return(&RES);
}

/* (<= 1 2) */
VALUE *
cmd_lethan(LONG argc, VALUE *argv)
{
    setnumres(ARG1.val_Value.Number <= ARG2.val_Value.Number);
    return(&RES);
}

/*
 * (nop)
 */
VALUE *
cmd_nop(LONG argc, VALUE *argv)
{
    setnumres(FALSE);
    return(&RES);
}