/*	EVAL.C: Expresion evaluation functions for
		MicroEMACS

	written 1986 by Daniel Lawrence 			*/

#include	<stdio.h>
#include	"estruct.h"
#include	"etype.h"
#include	"edef.h"
#include	"elang.h"
#include	"evar.h"

PASCAL NEAR varinit()	/* initialize the user variable list */
{
	register int i;

	for (i=0; i < MAXVARS; i++)
		uv[i].u_name[0] = 0;
}

PASCAL NEAR varclean()	/* initialize the user variable list */
{
	register int i;

	for (i=0; i < MAXVARS; i++)
		if (uv[i].u_name[0] != 0)
			free(uv[i].u_value);
}

unsigned char *PASCAL NEAR gtfun(fname)	/* evaluate a function */
unsigned char *fname;			/* name of function to evaluate */
{
	register int fnum;		/* index to function to eval */
	register int arg;		/* value of some arguments */
	unsigned char arg1[NSTRING];	/* value of first argument */
	unsigned char arg2[NSTRING];	/* value of second argument */
	unsigned char arg3[NSTRING];	/* value of third argument */
	static unsigned char result[2 * NSTRING];/* string result */
#if	ENVFUNC
	unsigned char *getenv();	/* get environment string */
#endif

	/* look the function up in the function table */

	fname[3] = 0;		/* only first 3 chars significant */
	mklower(fname); 	/* and let it be upper or lower case */

#if	BINARY
	fnum = binary(fname, funval, NFUNCS);

	/* return errorm on a bad reference */

	if (fnum == -1)
		return(errorm);
#else
	for (fnum = 0; fnum < NFUNCS; fnum++)
		if (strcmp(fname, funcs[fnum].f_name) == 0)
			break;

	/* return errorm on a bad reference */

	if (fnum == NFUNCS)
		return(errorm);
#endif

	/* if needed, retrieve the first argument */

	if (funcs[fnum].f_type >= MONAMIC)
	{
		if (macarg(arg1) != TRUE)
			return(errorm);

		/* if needed, retrieve the second argument */

		if (funcs[fnum].f_type >= DYNAMIC)
		{
			if (macarg(arg2) != TRUE)
				return(errorm);

			/* if needed, retrieve the third argument */

			if (funcs[fnum].f_type >= TRINAMIC)
				if (macarg(arg3) != TRUE)
					return(errorm);
		}
	}

	/* and now evaluate it! */

	switch (fnum)
	{
		case UFADD:	return(int_asc(asc_int(arg1) + asc_int(arg2)));
		case UFSUB:	return(int_asc(asc_int(arg1) - asc_int(arg2)));
		case UFTIMES:	return(int_asc(asc_int(arg1) * asc_int(arg2)));
		case UFDIV:	return(int_asc(asc_int(arg1) / asc_int(arg2)));
		case UFMOD:	return(int_asc(asc_int(arg1) % asc_int(arg2)));
		case UFNEG:	return(int_asc(-asc_int(arg1)));
		case UFCAT:	strcpy(result, arg1);
				return(strcat(result, arg2));
		case UFLEFT:	return(bytecopy(result, arg1, asc_int(arg2)));
		case UFRIGHT:	arg = asc_int(arg2);
				if (arg > strlen(arg1))
					arg = strlen(arg1);
				return(strcpy(result,
					&arg1[strlen(arg1) - arg]));
		case UFMID:	arg = asc_int(arg2);
				if (arg > strlen(arg1))
					arg = strlen(arg1);
				return(bytecopy(result, &arg1[arg-1],
					asc_int(arg3)));
		case UFNOT:	return(ltos(stol(arg1) == FALSE));
		case UFEQUAL:	return(ltos(asc_int(arg1) == asc_int(arg2)));
		case UFLESS:	return(ltos(asc_int(arg1) < asc_int(arg2)));
		case UFGREATER: return(ltos(asc_int(arg1) > asc_int(arg2)));
		case UFSEQUAL:	return(ltos(strcmp(arg1, arg2) == 0));
		case UFSLESS:	return(ltos(strcmp(arg1, arg2) < 0));
		case UFSGREAT:	return(ltos(strcmp(arg1, arg2) > 0));
		case UFIND:	return(strcpy(result, fixnull(getval(arg1))));
		case UFAND:	return(ltos(stol(arg1) && stol(arg2)));
		case UFOR:	return(ltos(stol(arg1) || stol(arg2)));
		case UFLENGTH:	return(int_asc(strlen(arg1)));
		case UFUPPER:	return(mkupper(arg1));
		case UFLOWER:	return(mklower(arg1));
		case UFTRUTH:	return(ltos(asc_int(arg1) == 42));
		case UFASCII:	return(int_asc((int)arg1[0]));
		case UFCHR:	result[0] = asc_int(arg1);
				result[1] = 0;
				return(result);
		case UFGTCMD:	cmdstr(getcmd(), result);
				return(result);
		case UFGTKEY:	result[0] = tgetc();
				result[1] = 0;
				return(result);
		case UFRND:	return(int_asc((ernd() % absv(asc_int(arg1))) + 1));
		case UFABS:	return(int_asc(absv(asc_int(arg1))));
		case UFSINDEX:	return(int_asc(sindex(arg1, arg2)));
		case UFENV:
#if	ENVFUNC
				return(fixnull(getenv(arg1)));
#else
				return("");
#endif
		case UFBIND:	return(transbind(arg1));
		case UFEXIST:	return(ltos(fexist(arg1)));
		case UFFIND:
				return(fixnull(flook(arg1, TRUE)));
		case UFBAND:	return(int_asc(asc_int(arg1) & asc_int(arg2)));
		case UFBOR:	return(int_asc(asc_int(arg1) | asc_int(arg2)));
		case UFBXOR:	return(int_asc(asc_int(arg1) ^ asc_int(arg2)));
		case UFBNOT:	return(int_asc(~asc_int(arg1)));
		case UFXLATE:	return(xlat(arg1, arg2, arg3));
		case UFTRIM:	return(trimstr(arg1));
		case UFSLOWER:	return(setlower(arg1, arg2), "");
		case UFSUPPER:	return(setupper(arg1, arg2), "");
	}

	meexit(-11);	/* never should get here */
}

unsigned char *PASCAL NEAR gtusr(vname)	/* look up a user var's value */
unsigned char *vname;			/* name of user variable to fetch */
{
	register int vnum;		/* ordinal number of user var */
	register unsigned char *vptr;	/* temp pointer to function value */

	/* scan the list looking for the user var name */

	for (vnum = 0; vnum < MAXVARS; vnum++)
	{
		if (uv[vnum].u_name[0] == 0)
			return(errorm);

		if (strcmp(vname, uv[vnum].u_name) == 0)
		{
			vptr = uv[vnum].u_value;

			if (vptr)
				return(vptr);
			else
				return(errorm);
		}
	}

	/* return errorm if we run off the end */

	return(errorm);
}

#if	BINARY

unsigned char *PASCAL NEAR funval(i)
int i;
{
	return(funcs[i].f_name);
}

unsigned char *PASCAL NEAR envval(i)
int i;
{
	return(envars[i]);
}

PASCAL NEAR binary(key, tval, tlength)
unsigned char *key;			/* key string to look for */
unsigned char *(PASCAL NEAR *tval)();	/* ptr to function to fetch table value with */
int tlength;				/* length of table to search */
{
	int l, u;	/* lower and upper limits of binary search */
	int i;		/* current search index */
	int cresult;	/* result of comparison */

	/* set current search limit as entire list */

	l = 0;
	u = tlength - 1;

	/* get the midpoint! */

	while (u >= l)
	{
		i = (l + u) >> 1;

		/* do the comparison */

		cresult = strcmp(key, (*tval)(i));

		if (cresult == 0)
			return(i);

		if (cresult < 0)
			u = i - 1;
		else
			l = i + 1;
	}
	return(-1);
}
#endif

unsigned char *PASCAL NEAR gtenv(vname)
unsigned char *vname;		/* name of environment variable to retrieve */
{
	register int vnum;		/* ordinal number of var referenced */
	static unsigned char result[2 * NSTRING];	/* string result */

	/* scan the list, looking for the referenced name */

#if	BINARY
	/* return errorm on a bad reference */

	if ((vnum = binary(vname, envval, NEVARS)) == -1)
		return(errorm);
#else
	for (vnum = 0; vnum < NEVARS; vnum++)
		if (strcmp(vname, envars[vnum]) == 0)
			break;

	/* return errorm on a bad reference */

	if (vnum == NEVARS)
		return(errorm);
#endif

	/* otherwise, fetch the appropriate value */

	switch (vnum)
	{
		case EVFILLCOL: return(int_asc(fillcol));
		case EVPAGELEN: return(int_asc(term.t_nrow + 1));
		case EVCURCOL:	return(int_asc(getccol(FALSE)));
		case EVCURLINE: return(int_asc(getcline()));
		case EVRAM:	return(int_asc((int)(envram / 1024l)));
		case EVFLICKER: return(ltos(flickcode));
		case EVCURWIDTH:return(int_asc(term.t_ncol));
		case EVCBFLAGS: return(int_asc(curbp->b_flag));
		case EVCBUFNAME:return(curbp->b_bname);
		case EVCFNAME:	return(curbp->b_fname);
		case EVSRES:	return(sres);
		case EVDEBUG:	return(ltos(macbug));
		case EVSTATUS:	return(ltos(cmdstatus));
		case EVPALETTE: return(palstr);
		case EVASAVE:	return(int_asc(gasave));
		case EVACOUNT:	return(int_asc(gacount));
		case EVLASTKEY: return(int_asc(lastkey));
		case EVCURCHAR: return(curwp->w_dotp->l_used ==
					curwp->w_doto ? int_asc('\r') :
				int_asc(lgetc(curwp->w_dotp, curwp->w_doto)));
		case EVDISCMD:	return(ltos(discmd));
		case EVVERSION: return(VERSION);
		case EVPROGNAME:return(PROGNAME);
		case EVLANG:	return(LANGUAGE);
		case EVSEED:	return(int_asc(seed));
		case EVDISINP:	return(ltos(disinp));
		case EVWLINE:	return(int_asc(curwp->w_ntrows));
		case EVCWLINE:	return(int_asc(getwpos()));
		case EVTARGET:	saveflag = lastflag;
				return(int_asc(curgoal));
		case EVSEARCH:	return(pat);
		case EVTIME:	return(timeset());
		case EVREPLACE: return(rpat);
		case EVMATCH:	return(fixnull(patmatch));
		case EVKILL:	return(getkill());
		case EVREGION:	return(getreg());
		case EVCMODE:	return(int_asc(curbp->b_mode));
		case EVGMODE:	return(int_asc(gmode));
		case EVTPAUSE:	return(int_asc(term.t_pause));
		case EVPENDING:
#if	TYPEAH
				return(ltos(typahead()));
#else
				return(falsem);
#endif
		case EVLWIDTH:	return(int_asc(llength(curwp->w_dotp)));
		case EVLINE:	return(getctext());
		case EVGFLAGS:	return(int_asc(gflags));
		case EVRVAL:	return(int_asc(rval));
		case EVREADHK:	return(fixnull(getfname(&readhook)));
		case EVWRAPHK:	return(fixnull(getfname(&wraphook)));
		case EVCMDHK:	return(fixnull(getfname(&cmdhook)));
		case EVXPOS:	return(int_asc(xpos));
		case EVYPOS:	return(int_asc(ypos));
		case EVSTERM:	cmdstr(sterm, result);
				return(result);
		case EVMODEFLAG:return(ltos(modeflag));
		case EVSSCROLL: return(ltos(sscroll));
		case EVLASTMESG:return(lastmesg);
		case EVHARDTAB: return(int_asc(tabsize));
		case EVSOFTTAB: return(int_asc(stabsize));
		case EVSSAVE:	return(ltos(ssave));
		case EVFCOL:	return(int_asc(curwp->w_fcol));
		case EVHSCROLL: return(ltos(hscroll));
		case EVHJUMP:	return(int_asc(hjump));
		case EVBUFHOOK: return(fixnull(getfname(&bufhook)));
		case EVEXBHOOK: return(fixnull(getfname(&exbhook)));
		case EVWRITEHK: return(fixnull(getfname(&writehook)));
		case EVDIAGFLAG:return(ltos(diagflag));
		case EVMSFLAG:	return(ltos(mouseflag));
		case EVOCRYPT:	return(ltos(oldcrypt));
	}
	meexit(-12);	/* again, we should never get here */
}

unsigned char *PASCAL NEAR fixnull(s)	/* Don't return NULL pointers! */
unsigned char *s;
{
	if (s == NULL)
		return("");
	else
		return(s);
}

unsigned char *PASCAL NEAR getkill()	/* return some of the contents of the kill buffer */
{
	register int size;		/* max number of chars to return */
	unsigned char value[NSTRING];	/* temp buffer for value */

	if (kbufh == NULL)	/* no kill buffer....just a null string */
		value[0] = 0;
	else
	{
		/* copy in the contents... */

		if (kused < NSTRING)
			size = kused;
		else
			size = NSTRING - 1;

		bytecopy(value, kbufh->d_chunk, size);
	}

	/* and return the constructed value */

	return(value);
}

unsigned char *PASCAL NEAR trimstr(s)	/* trim whitespace off the end of a string */
unsigned char *s;			/* string to trim */
{
	unsigned char *sp;	/* backward index */

	sp = s + strlen(s) - 1;

	while ((sp >= s) && (*sp == ' ' || *sp == '\t'))
		--sp;

	*(sp+1) = 0;

	return(s);
}

int PASCAL NEAR setvar(f, n)		/* set a variable */
int f;		/* default flag */
int n;		/* numeric arg (can overide prompted value) */
{
	register int status;		/* status return */
	VDESC vd;			/* variable num/type */
	unsigned char var[NVSIZE+1];	/* name of variable to fetch */
	unsigned char value[NSTRING];	/* value to set variable to */

	/* first get the variable to set.. */

	if (clexec == FALSE)
	{
		status = mlreply(TEXT51, &var[0], NVSIZE+1);
/*				 "Variable to set: " */

		if (status != TRUE)
			return(status);
	}
	else
	{	/* macro line argument */
		/* grab token and skip it */

		execstr = token(execstr, var, NVSIZE + 1);
	}

	/* check the legality and find the var */

	findvar(var, &vd, NVSIZE + 1);

	/* if its not legal....bitch */

	if (vd.v_type == -1)
	{
		mlwrite(TEXT52, var);
/*			"%%No such variable as '%s'" */
		return(FALSE);
	}

	/* get the value for that variable */

	if (f == TRUE)
		strcpy(value, int_asc(n));
	else
	{
		status = mlreply(TEXT53, &value[0], NSTRING);
/*				 "Value: " */
		if (status != TRUE)
			return(status);
	}

	/* and set the appropriate value */

	status = svar(&vd, value);

#if	DEBUGM
	/* if $debug == TRUE, every assignment will echo a statment to
	   that effect here. */

	if (macbug && (strcmp(var, "%track") != 0))
	{
		strcpy(outline, "(((");

		strcat(outline, var);
		strcat(outline, " <- ");

		/* and lastly the value we tried to assign */

		strcat(outline, value);
		strcat(outline, ")))");

		/* expand '%' to "%%" so mlwrite wont bitch */

		makelit(outline);

		/* write out the debug line */

		mlforce(outline);
		update(TRUE);

		/* and get the keystroke to hold the output */

		if (getkey() == abortc)
		{
			mlforce(TEXT54);
/*				"[Macro aborted]" */
			status = FALSE;
		}
	}
#endif

	/* and return it */

	return(status);
}

PASCAL NEAR findvar(var, vd, size)	/* find a variables type and name */
unsigned char *var;	/* name of var to get */
VDESC *vd;		/* structure to hold type and ptr */
int size;		/* size of var array */
{
	register int vnum;	/* subscript in varable arrays */
	register int vtype;	/* type to return */

fvar:	vtype = -1;
	switch (var[0])
	{
		case '$': /* check for legal enviromnent var */
			for (vnum = 0; vnum < NEVARS; vnum++)
				if (strcmp(&var[1], envars[vnum]) == 0)
				{
					vtype = TKENV;
					break;
				}
			break;

		case '%': /* check for existing legal user variable */
			for (vnum = 0; vnum < MAXVARS; vnum++)
				if (strcmp(&var[1], uv[vnum].u_name) == 0)
				{
					vtype = TKVAR;
					break;
				}
			if (vnum < MAXVARS)
				break;

			/* create a new one??? */
			for (vnum = 0; vnum < MAXVARS; vnum++)
				if (uv[vnum].u_name[0] == 0)
				{
					vtype = TKVAR;
					strcpy(uv[vnum].u_name, &var[1]);
					uv[vnum].u_value = NULL;
					break;
				}
			break;

		case '&':	/* indirect operator? */
			var[4] = 0;
			if (strcmp(&var[1], "ind") == 0)
			{
				/* grab token, and eval it */

				execstr = token(execstr, var, size);
				strcpy(var, fixnull(getval(var)));
				goto fvar;
			}
	}

	/* return the results */

	vd->v_num = vnum;
	vd->v_type = vtype;
}

int PASCAL NEAR svar(var, value)	/* set a variable */
VDESC *var;		/* variable to set */
unsigned char *value;	/* value to set to */
{
	register int vnum;		/* ordinal number of var refrenced */
	register int vtype;		/* type of variable to set */
	register int status;		/* status return */
	register int c; 		/* translated character */
	register unsigned char * sp;	/* scratch string pointer */

	/* simplify the vd structure (we are gonna look at it a lot) */

	vnum = var->v_num;
	vtype = var->v_type;

	/* and set the appropriate value */

	status = TRUE;

	switch (vtype)
	{
	case TKVAR: /* set a user variable */
		if (uv[vnum].u_value != NULL)
			free(uv[vnum].u_value);

		if ((sp = malloc(strlen(value) + 1)) == NULL)
			return(FALSE);

		strcpy(sp, value);
		uv[vnum].u_value = sp;
		break;

	case TKENV: /* set an environment variable */
		status = TRUE;	/* by default */
		switch (vnum)
		{
		case EVFILLCOL: fillcol = asc_int(value);
				break;
		case EVPAGELEN: status = newsize(TRUE, asc_int(value));
				break;
		case EVCURCOL:	status = setccol(asc_int(value));
				break;
		case EVCURLINE: status = gotoline(TRUE, asc_int(value));
				break;
		case EVRAM:	break;
		case EVFLICKER: flickcode = stol(value);
				break;
		case EVCURWIDTH:status = newwidth(TRUE, asc_int(value));
				break;
		case EVCBFLAGS: curbp->b_flag = (curbp->b_flag & ~(BFCHG|BFINVS))
					| (asc_int(value) & (BFCHG&BFINVS));
				lchange(WFMODE);
				break;
		case EVCBUFNAME:strcpy(curbp->b_bname, value);
				curwp->w_flag |= WFMODE;
				break;
		case EVCFNAME:	strcpy(curbp->b_fname, value);
				curwp->w_flag |= WFMODE;
				break;
		case EVSRES:	status = TTrez(value);
				break;
		case EVDEBUG:	macbug = stol(value);
				break;
		case EVSTATUS:	cmdstatus = stol(value);
				break;
		case EVPALETTE: bytecopy(palstr, value, 48);
				spal(palstr);
				break;
		case EVASAVE:	gasave = asc_int(value);
				break;
		case EVACOUNT:	gacount = asc_int(value);
				break;
		case EVLASTKEY: lastkey = asc_int(value);
				break;
		case EVCURCHAR: ldelete(1L, FALSE);	/* delete 1 char */
				c = asc_int(value);
				if (c == '\r')
					lnewline(FALSE, 1);
				else
					linsert(1, c);
				backchar(FALSE, 1);
				break;
		case EVDISCMD:	discmd = stol(value);
				break;
		case EVVERSION: break;
		case EVPROGNAME:break;
		case EVLANG:	break;
		case EVSEED:	seed = asc_int(value);
				break;
		case EVDISINP:	disinp = stol(value);
				break;
		case EVWLINE:	status = resize(TRUE, asc_int(value));
				break;
		case EVCWLINE:	status = forwline(TRUE,
						asc_int(value) - getwpos());
				break;
		case EVTARGET:	curgoal = asc_int(value);
				thisflag = saveflag;
				break;
		case EVSEARCH:	strcpy(pat, value);
				setjtable(pat); /* Set up fast search arrays  */
#if	MAGIC
				mcclear();
#endif
				break;
		case EVTIME:	break;
		case EVREPLACE: strcpy(rpat, value);
				break;
		case EVMATCH:	break;
		case EVKILL:	break;
		case EVREGION:	break;
		case EVCMODE:	curbp->b_mode = asc_int(value);
				curwp->w_flag |= WFMODE;
				break;
		case EVGMODE:	gmode = asc_int(value);
				break;
		case EVTPAUSE:	term.t_pause = asc_int(value);
				break;
		case EVPENDING: break;
		case EVLWIDTH:	break;
		case EVLINE:	putctext(value);
				break;
		case EVGFLAGS:	gflags = asc_int(value);
				break;
		case EVRVAL:	break;
		case EVREADHK:	setkey(&readhook, BINDFNC, value);
				break;
		case EVWRAPHK:	setkey(&wraphook, BINDFNC, value);
				break;
		case EVCMDHK:	setkey(&cmdhook, BINDFNC, value);
				break;
		case EVXPOS:	xpos = asc_int(value);
				break;
		case EVYPOS:	ypos = asc_int(value);
				break;
		case EVSTERM:	sterm = stock(value);
				break;
		case EVMODEFLAG:modeflag = stol(value);
				upwind();
				break;
		case EVSSCROLL: sscroll = stol(value);
				break;
		case EVLASTMESG:strcpy(lastmesg, value);
				break;
		case EVHARDTAB: tabsize = asc_int(value);
				upwind();
				break;
		case EVSOFTTAB: stabsize = asc_int(value);
				upwind();
				break;
		case EVSSAVE:	ssave = stol(value);
				break;
		case EVFCOL:	curwp->w_fcol = asc_int(value);
				if (curwp->w_fcol < 0)
					curwp->w_fcol = 0;
				curwp->w_flag |= WFHARD | WFMODE;
				break;
		case EVHSCROLL: hscroll = stol(value);
				lbound = 0;
				break;
		case EVHJUMP:	hjump = asc_int(value);
				if (hjump < 1)
					hjump = 1;
				if (hjump > term.t_ncol - 1)
					hjump = term.t_ncol - 1;
				break;
		case EVBUFHOOK: setkey(&bufhook, BINDFNC, value);
				break;
		case EVEXBHOOK: setkey(&exbhook, BINDFNC, value);
				break;
		case EVWRITEHK: setkey(&writehook, BINDFNC, value);
				break;
		case EVDIAGFLAG:diagflag = stol(value);
				break;
		case EVMSFLAG:	mouseflag = stol(value);
				break;
		case EVOCRYPT:	oldcrypt = stol(value);
				break;
		}
		break;
	}
	return(status);
}

/*	asc_int:	ascii string to integer......This is too
		inconsistant to use the system's	*/

PASCAL NEAR asc_int(st)
unsigned char *st;
{
	int result;		/* resulting number */
	int sign;		/* sign of resulting number */
	unsigned char c; 	/* current char being examined */

	result = 0;
	sign = 1;

	/* skip preceding whitespace */

	while (*st == ' ' || *st == '\t')
		++st;

	/* check for sign */

	if (*st == '-')
	{
		sign = -1;
		++st;
	}

	if (*st == '+')
		++st;

	/* scan digits, build value */

	while ((c = *st++))
		if (c >= '0' && c <= '9')
			result = result * 10 + c - '0';
		else
			break;

	return(result * sign);
}

/*	int_asc:	integer to ascii string.......... This is too
			inconsistant to use the system's	*/

unsigned char *PASCAL NEAR int_asc(i)
int i;	/* integer to translate to a string */
{
	register int digit;		/* current digit being used */
	register unsigned char *sp;	/* pointer into result */
	register int sign;		/* sign of resulting number */
	static unsigned char result[INTWIDTH+1]; /* resulting string */

	/* record the sign...*/

	sign = 1;

	if (i < 0)
	{
		sign = -1;
		i = -i;
	}

	/* and build the string (backwards!) */

	sp = result + INTWIDTH;
	*sp = 0;

	do
	{
		digit = i % 10;
		*(--sp) = '0' + digit;	/* and install the new digit */
		i = i / 10;
	}
	while (i);

	/* and fix the sign */

	if (sign == -1)
	{
		*(--sp) = '-';	/* and install the minus sign */
	}

	return(sp);
}

int PASCAL NEAR gettyp(token)	/* find the type of a passed token */
unsigned char *token;	/* token to analyze */
{
	register unsigned char c;	/* first char in token */

	/* grab the first char (this is all we need) */

	c = *token;

	/* no blanks!!! */

	if (c == 0)
		return(TKNUL);

	/* a numeric literal? */

	if (c >= '0' && c <= '9')
		return(TKLIT);

	switch (c)
	{
		case '"':	return(TKSTR);

		case '!':	return(TKDIR);
		case '@':	return(TKARG);
		case '#':	return(TKBUF);
		case '$':	return(TKENV);
		case '%':	return(TKVAR);
		case '&':	return(TKFUN);
		case '*':	return(TKLBL);

		default:	return(TKCMD);
	}
}

unsigned char *PASCAL NEAR getval(token) /* find the value of a token */
unsigned char *token;		/* token to evaluate */
{
	register int status;	/* error return */
	register BUFFER *bp;	/* temp buffer pointer */
	register int blen;	/* length of buffer argument */
	register int distmp;	/* temporary discmd flag */
	static unsigned char buf[NSTRING];/* string buffer for some returns */

	switch (gettyp(token))
	{
		case TKNUL:	return("");

		case TKARG:	/* interactive argument */
				strcpy(token, fixnull(getval(&token[1])));
				distmp = discmd;	/* echo it always! */
				discmd = TRUE;
				status = getstring(token,
					   buf, NSTRING, ctoec('\r'));
				discmd = distmp;

				if (status == ABORT)
					return(NULL);
				else
					return(buf);

		case TKBUF:	/* buffer contents fetch */

				/* grab the right buffer */

				strcpy(token, fixnull(getval(&token[1])));
				
				if ((bp = bfind(token, FALSE, 0)) == NULL)
					return(NULL);

				/* if the buffer is displayed, get the window
				   vars instead of the buffer vars */

				if (bp->b_nwnd > 0)
				{
					curbp->b_dotp = curwp->w_dotp;
					curbp->b_doto = curwp->w_doto;
				}

				/* make sure we are not at the end */

				if (bp->b_linep == bp->b_dotp)
					return(NULL);

				/* grab the line as an argument */

				blen = bp->b_dotp->l_used - bp->b_doto;

				if (blen > NSTRING)
					blen = NSTRING;

				bytecopy(buf, bp->b_dotp->l_text + bp->b_doto,
					blen);

				buf[blen] = 0;

				/* and step the buffer's line ptr ahead a line */

				bp->b_dotp = bp->b_dotp->l_fp;
				bp->b_doto = 0;

				/* if displayed buffer, reset window ptr vars*/

				if (bp->b_nwnd > 0)
				{
					curwp->w_dotp = curbp->b_dotp;
					curwp->w_doto = 0;
					curwp->w_flag |= WFMOVE;
				}

				/* and return the spoils */
				return(buf);

		case TKVAR:	return(gtusr(token+1));
		case TKENV:	return(gtenv(token+1));
		case TKFUN:	return(gtfun(token+1));
		case TKDIR:	return(NULL);
		case TKLBL:	return(NULL);
		case TKLIT:	return(token);
		case TKSTR:	return(token+1);
		case TKCMD:	return(token);
	}
}

int PASCAL NEAR stol(val)	/* convert a string to a numeric logical */
unsigned char *val;	/* value to check for stol */
{
	/* check for logical values */

	if (val[0] == 'F')
		return(FALSE);

	if (val[0] == 'T')
		return(TRUE);

	/* check for numeric truth (!= 0) */

	return((asc_int(val) != 0));
}

unsigned char *PASCAL NEAR ltos(val)	/* numeric logical to string logical */
int val;	/* value to translate */
{
	if (val)
		return(truem);
	else
		return(falsem);
}

unsigned char *PASCAL NEAR mkupper(str)	/* make a string upper case */
unsigned char *str;		/* string to upper case */
{
	register unsigned char *sp;

	sp = str;

	while (*sp)
		uppercase(sp++);

	return(str);
}

unsigned char *PASCAL NEAR mklower(str)	/* make a string lower case */
unsigned char *str;		/* string to lower case */
{
	register unsigned char *sp;

	sp = str;

	while (*sp)
		lowercase(sp++);

	return(str);
}

int PASCAL NEAR absv(x) /* take the absolute value of an integer */
int x;
{
	return(x < 0 ? -x : x);
}

int PASCAL NEAR ernd()	/* returns a random integer */
{
	return(seed = absv(seed * 1721 + 10007));
}

int PASCAL NEAR sindex(source, pattern) /* find pattern within source */
unsigned char *source;	/* source string to search */
unsigned char *pattern;	/* string to look for */
{
	register unsigned char *sp;	/* ptr to current position to scan */
	register unsigned char *csp;	/* ptr to source string during comparison */
	register unsigned char *cp;	/* ptr to place to check for equality */

	/* scanning through the source string */

	sp = source;

	while (*sp)
	{
		/* scan through the pattern */

		cp = pattern;
		csp = sp;

		while (*cp)
		{
			if (!eq(*cp, *csp))
				break;
			++cp;
			++csp;
		}

		/* was it a match? */

		if (*cp == 0)
			return((int)(sp - source) + 1);
		++sp;
	}

	/* no match at all.. */

	return(0);
}

/*	Filter a string through a translation table	*/

unsigned char *PASCAL NEAR xlat(source, lookup, trans)
unsigned char *source;	/* string to filter */
unsigned char *lookup;	/* characters to translate */
unsigned char *trans;	/* resulting translated characters */
{
	register unsigned char *sp;	/* pointer into source table */
	register unsigned char *lp;	/* pointer into lookup table */
	register unsigned char *rp;	/* pointer into result */
	static unsigned char result[NSTRING];	/* temporary result */

	/* scan source string */

	sp = source;
	rp = result;

	while (*sp)
	{
		/* scan lookup table for a match */

		lp = lookup;

		while (*lp)
		{
			if (*sp == *lp)
			{
				*rp++ = trans[lp - lookup];
				goto xnext;
			}
			++lp;
		}

		/* no match, copy in the source char untranslated */

		*rp++ = *sp;

xnext:		++sp;
	}

	/* terminate and return the result */

	*rp = 0;

	return(result);
}

#if	DEBUGM

int PASCAL NEAR dispvar(f, n)		/* display a variable's value */
int f;		/* default flag */
int n;		/* numeric arg (can overide prompted value) */
{
	register int status;		/* status return */
	VDESC vd;			/* variable num/type */
	unsigned char var[NVSIZE+1];	/* name of variable to fetch */

	/* first get the variable to display.. */

	if (clexec == FALSE)
	{
		status = mlreply(TEXT55, &var[0], NVSIZE+1);
/*				 "Variable to display: " */

		if (status != TRUE)
			return(status);
	}
	else
	{	/* macro line argument */
		/* grab token and skip it */

		execstr = token(execstr, var, NVSIZE + 1);
	}

	/* check the legality and find the var */

	findvar(var, &vd, NVSIZE + 1);

	/* if its not legal....bitch */

	if (vd.v_type == -1)
	{
		mlwrite(TEXT52, var);
/*			"%%No such variable as '%s'" */
		return(FALSE);
	}

	/* and display the value */

	strcpy(outline, var);
	strcat(outline, " = ");

	/* and lastly the current value */

	strcat(outline, fixnull(getval(var)));

	/* expand '%' to "%%" so mlwrite wont bitch */

	makelit(outline);

	/* write out the result */

	mlforce(outline);
	update(TRUE);

	/* and return */

	return(TRUE);
}

/*	describe-variables	Bring up a fake buffer and list the contents
				of all the environment variables
*/

PASCAL NEAR desvars(f, n)
{
	register WINDOW *wp;	/* scanning pointer to windows */
	register BUFFER *bp;	/* buffer to put binding list into */
	register int uindex;	/* index into uvar table */
	register int cmark;	/* current mark */
	unsigned char outseq[80]; /* output buffer for keystroke sequence */

	/* split the current window to make room for the variable list */

	if (splitwind(FALSE, 1) == FALSE)
			return(FALSE);

	/* and get a buffer for it */

	bp = bfind(TEXT56, TRUE, 0);
/*		   "Variable list" */

	if (bp == NULL || bclear(bp) == FALSE)
	{
		mlwrite(TEXT57);
/*			"Can not display variable list" */
		return(FALSE);
	}

	/* let us know this is in progress */

	mlwrite(TEXT58);
/*		"[Building variable list]" */

	/* disconect the current buffer */

	if (--curbp->b_nwnd == 0)		/* Last use.		*/
	{
		curbp->b_dotp  = curwp->w_dotp;
		curbp->b_doto  = curwp->w_doto;

		for (cmark = 0; cmark < NMARKS; cmark++)
		{
			curbp->b_markp[cmark] = curwp->w_markp[cmark];
			curbp->b_marko[cmark] = curwp->w_marko[cmark];
		}
		curbp->b_fcol  = curwp->w_fcol;
	}

	/* connect the current window to this buffer */

	curbp = bp;		/* make this buffer current in current window */
	bp->b_mode = 0; 	/* no modes active in binding list */
	bp->b_nwnd++;		/* mark us as more in use */
	wp = curwp;
	wp->w_bufp = bp;
	wp->w_linep = bp->b_linep;
	wp->w_flag = WFHARD|WFFORCE;
	wp->w_dotp = bp->b_dotp;
	wp->w_doto = bp->b_doto;

	for (cmark = 0; cmark < NMARKS; cmark++)
	{
		wp->w_markp[cmark] = NULL;
		wp->w_marko[cmark] = 0;
	}

	/* build the environment variable list */

	for (uindex = 0; uindex < NEVARS; uindex++)
	{
		/* add in the environment variable name */

		strcpy(outseq, "$");
		strcat(outseq, envars[uindex]);
		pad(outseq, 14);

		/* add in the value */

		strcat(outseq, gtenv(envars[uindex]));
		strcat(outseq, "\r");

		/* and add it as a line into the buffer */

		if (linstr(outseq) != TRUE)
			return(FALSE);
	}

	linstr("\r\r");

	/* build the user variable list */

	for (uindex = 0; uindex < MAXVARS; uindex++)
	{
		if (uv[uindex].u_name[0] == 0)
			break;

		/* add in the user variable name */

		strcpy(outseq, "%");
		strcat(outseq, uv[uindex].u_name);
		pad(outseq, 14);

		/* add in the value */

		strcat(outseq, uv[uindex].u_value);
		strcat(outseq, "\r");

		/* and add it as a line into the buffer */

		if (linstr(outseq) != TRUE)
			return(FALSE);
	}

	curwp->w_bufp->b_mode |= MDVIEW;	/* put this buffer view mode */
	curbp->b_flag &= ~BFCHG;		/* don't flag this as a change */
	wp->w_dotp = lforw(bp->b_linep);	/* back to the beginning */
	wp->w_doto = 0;
	upmode();
	mlerase();				/* clear the mode line */
	return(TRUE);
}

/*	describe-functions	Bring up a fake buffer and list the
				names of all the functions
*/

PASCAL NEAR desfunc(f, n)
{
	register WINDOW *wp;	/* scanning pointer to windows */
	register BUFFER *bp;	/* buffer to put binding list into */
	register int uindex;	/* index into funcs table */
	register int cmark;	/* current mark */
	unsigned char outseq[80]; /* output buffer for keystroke sequence */

	/* split the current window to make room for the variable list */

	if (splitwind(FALSE, 1) == FALSE)
			return(FALSE);

	/* and get a buffer for it */

	bp = bfind(TEXT211, TRUE, 0);
/*		   "Function list" */

	if (bp == NULL || bclear(bp) == FALSE)
	{
		mlwrite(TEXT212);
/*			"Can not display function list" */
		return(FALSE);
	}

	/* let us know this is in progress */

	mlwrite(TEXT213);
/*		"[Building function list]" */

	/* disconect the current buffer */

	if (--curbp->b_nwnd == 0)		/* Last use.		*/
	{
		curbp->b_dotp  = curwp->w_dotp;
		curbp->b_doto  = curwp->w_doto;

		for (cmark = 0; cmark < NMARKS; cmark++)
		{
			curbp->b_markp[cmark] = curwp->w_markp[cmark];
			curbp->b_marko[cmark] = curwp->w_marko[cmark];
		}
		curbp->b_fcol  = curwp->w_fcol;
	}

	/* connect the current window to this buffer */

	curbp = bp;		/* make this buffer current in current window */
	bp->b_mode = 0; 	/* no modes active in binding list */
	bp->b_nwnd++;		/* mark us as more in use */
	wp = curwp;
	wp->w_bufp = bp;
	wp->w_linep = bp->b_linep;
	wp->w_flag = WFHARD|WFFORCE;
	wp->w_dotp = bp->b_dotp;
	wp->w_doto = bp->b_doto;

	for (cmark = 0; cmark < NMARKS; cmark++)
	{
		wp->w_markp[cmark] = NULL;
		wp->w_marko[cmark] = 0;
	}

	/* build the function list */

	for (uindex = 0; uindex < NFUNCS; uindex++)
	{
		/* add in the environment variable name */

		strcpy(outseq, "&");
		strcat(outseq, funcs[uindex]);
		strcat(outseq, "\r");

		/* and add it as a line into the buffer */

		if (linstr(outseq) != TRUE)
			return(FALSE);
	}

	linstr("\r");

	curwp->w_bufp->b_mode |= MDVIEW;	/* put this buffer view mode */
	curbp->b_flag &= ~BFCHG;		/* don't flag this as a change */
	wp->w_dotp = lforw(bp->b_linep);	/* back to the beginning */
	wp->w_doto = 0;
	upmode();
	mlwrite("");				/* clear the mode line */
	return(TRUE);
}

pad(s, len)		/* pad a string to indicated length */
unsigned char *s;	/* string to add spaces to */
int len;		/* wanted length of string */
{
	while (strlen(s) < len)
	{
		strcat(s, " ");
		s[len] = 0;
	}
}
#endif