// Expression evaluation functions

#include "Include.h"
#include "evar.h"

#define SINGLE_LINE 0xc4
#define DOUBLE_LINE 0xcd

unsigned char kool;

CONST char errorm[] = "ERROR";   /* error literal     */
CONST char truem[] = "TRUE";     /* TRUE literal      */
CONST char falsem[] = "FALSE";   /* FALSE litereal    */

int DNEAR saveflag;              /* Flags, saved with the $target var */

/// Characters used in the divider line between windows
unsigned char kool_array[] =
{ ' ',
   SINGLE_LINE,
   DOUBLE_LINE,
   '-',
   '=',
   '~',
   '.',
   ':'
};
//-

/// internally used

char *STD envval(int);
char *STD funval(int);
char *STD getctext(void);
char *REG getkill(void);
char *STD getregg(char *);
char *REG gtenv(char *);
char *REG gtfun(char *);
char *REG ltos(int);
char *STD transbind(char *);
char *REG trimstr(char *);
char *REG xlat(char *, char *, char *);
int   REG absv(int);
int   STD getcwnum(void);
int   STD gettwnum(void);
int   STD getwpos(void);
int   REG is_num(char *);
int   REG setlower(char *, char *);
int   REG setupper(char *, char *);
int   REG svar(VDESC *, char *);
int       setkey(KEYTAB *, char *);
int   REG findvar(char *, VDESC *, int);
int   STD newsize(int, int);
int   STD putctext(char *);
int   STD setccol(int);


/// varinit()
/* initialize the user variable list */
REG varinit(void)
{
   register int i;

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

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

   /* limit comparisons to significant length */
   if (strlen(vname) >= NVSIZE)  /* "%" counts, but is not passed */
      vname[NVSIZE-1] = '\0';

   /* 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);
}
//-

/// binary()
/*
**
** char *key;                 key string to look for
** char *(* STD tval)(int);   ptr to function to fetch table value with
** int tlength;               length of table to search
****************************/
REG binary(char *key, char *(*STD tval)(int), int tlength)
{
   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);
}
//-

/// setvar()
/* set a variable
**
** int f;      default flag
** int n;      numeric arg (can overide prompted value)
***********/
int STD setvar(int f, int n)
{
   register int status; /* status return */
   VDESC vd;      /* variable num/type */
   char var[NVSIZE+1];  /* name of variable to fetch */
   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 == ABORT)
         return(status);
   }

   /* and set the appropriate value */
   status = svar(&vd, value);


   /* and return it */
   return(status);
}
//-

/// asc_int()
/* asc_int: ascii string to integer......This is too
**    inconsistant to use the system's
**
** char *st;
**************/
int REG asc_int(char *st)
{
   int result; /* resulting number */
   int sign;   /* sign of resulting number */
   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()
/* int_asc: integer to ascii string.......... This is too
**       inconsistant to use the system's
**
** int i;      integer to translate to a string
***********/
char *REG int_asc(int i)
{
   register int digit;     /* current digit being used */
   register char *sp;      /* pointer into result */
   register int sign;      /* sign of resulting number */
   static 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);
}
//-

/// gettyp()
/* find the type of a passed token
**
** char *token;   /* token to analyze
****************/
int REG gettyp(char *token)
{
   register 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);
   }
}
//-

/// getval()
/* find the value of a token
**
** char *token    Token to evaluate
***************/
char *REG getval(char *token)
{
   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 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;
          // token=prompt
          status = getdlgstring(token, buf, gtusr("default"));
            discmd = distmp;
            if (status == ABORT)
               return(NULL);
            return(buf);

      case TKBUF: /* buffer contents fetch */

            /* grab the right buffer */
            strcpy(token, fixnull(getval(&token[1])));
            bp = bfind(token, FALSE, 0);
            if (bp == 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);
   }
}
//-

/// stol()
/* convert a string to a numeric logical
**
** char *val;     value to check for stol
****************/
int REG stol(char *val)
{
   /* 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));
}
//-

/// mkupper()
/* make a string upper case
**
** char *str;  string to upper case
***************/
char *REG mkupper(char *str)
{
   char *sp;

   sp = str;
   while (*sp)
      uppercase(sp++);
   return(str);
}
//-

/// mklower()
/*
** make a string lower case
**
** char *str;  string to lower case
**************/
char *REG mklower(char *str)
{
   char *sp;

   sp = str;
   while (*sp)
      lowercase(sp++);
   return(str);
}
//-

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

/// sindex()
/* find pattern within source
**
** char *source;     source string to search
** char *pattern;    string to look for
*******************/
int REG sindex(char *source, char *pattern)
{
   char *sp;   /* ptr to current position to scan */
   char *csp;  /* ptr to source string during comparison */
   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);
}
//-

// internally used

/// envval()
char *STD envval(int i)
{
   return(envars[i]);
}
//-

/// funval()
char *STD funval(int i)
{
   return(funcs[i].f_name);
}
//-

/// getctext()
/* getctext:   grab and return a string with the text of
** the current line
*/
char *STD getctext(void)
{
   register LINE *lp;   /* line to copy */
   register int size;   /* length of line to return */
   register char *sp;   /* string pointer into line */
   register char *dp;   /* string pointer into returned line */
   char rline[NSTRING]; /* line to return */

   /* find the contents of the current line and its length */
   lp = curwp->w_dotp;
   sp = lp->l_text;
   size = lp->l_used;
   if (size >= NSTRING)
      size = NSTRING - 1;

   /* copy it across */
   dp = rline;
   while (size--)
      *dp++ = *sp++;
   *dp = 0;
   return(rline);
}
//-

/// getkill()
/* return some of the contents of the kill buffer */
char *REG getkill(void)
{
   register int size;   /* max number of chars left to return */
   register char *sp;   /* ptr into KILL block data chunk */
   register char *vp;   /* ptr into return value */
   KILL *kptr;    /* ptr to the current KILL block */
   int counter;      /* index into data chunk */
   static char value[NSTRING];   /* temp buffer for value */

   /* no kill buffer....just a null string */
   if (kbufh == (KILL *)NULL) {
      value[0] = 0;
      return(value);
   }

   /* set up the output buffer */
   vp = value;
   size = NSTRING - 1;

   /* backed up characters? */
   if (kskip > 0) {
      kptr = kbufh;
      sp = &(kptr->d_chunk[kskip]);
      counter = kskip;
      while (counter++ < KBLOCK) {
         *vp++ = *sp++;
         if (--size == 0) {
            *vp = 0;
            return(value);
         }
      }
      kptr = kptr->d_next;
   } else {
      kptr = kbufh;
   }

   if (kptr != (KILL *)NULL) {
      while (kptr != kbufp) {
         sp = kptr->d_chunk;
         for (counter = 0; counter < KBLOCK; counter++) {
            *vp++ = *sp++;
            if (--size == 0) {
               *vp = 0;
               return(value);
            }
         }
         kptr = kptr->d_next;
      }
      counter = kused;
      sp = kptr->d_chunk;
      while (counter--) {
         *vp++ = *sp++;
         if (--size == 0) {
            *vp = 0;
            return(value);
         }
      }
   }

   /* and return the constructed value */
   *vp = 0;
   return(value);
}
//-

/// getregg
/* return some of the contents of the current region */
char *STD getregg(char *value)
{
   REGION region;

   /* get the region limits */
   if (getregion(&region) != TRUE)
      return(errorm);

   /* don't let the region be larger than a string can hold */
   if (region.r_size >= NSTRING)
      region.r_size = NSTRING - 1;
   return(regtostr(value, &region));
}
//-

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

   /* scan the list, looking for the referenced name */
   vnum = binary(vname, envval, NEVARS);

   /* return errorm on a bad reference */
   if (vnum == -1)
      return(errorm);

   /* 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(getlinenum(curbp, curwp->w_dotp)));
      case EVFINI:   return(ltos(fini));
      case EVQSTYLE:  return(int_asc(quote_style));
      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 EVDEBUG:  return(ltos(macbug));
      case EVSTATUS: return(ltos(cmdstatus));
      case EVAREAD:  return(int_asc(xl_acc_read));
      case EVAWRITE: return(int_asc(xl_acc_write));
      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));
//#if XENO_EMACS
//        // DLG append reg# to version#
//    case EVVERSION: return krypto_version(VERSION);
//#else
      case EVVERSION: return(VERSION);
//#endif
      case EVPROGNAME:return(PROGNAME);
      case EVTO:  return(dlg_to());
      case EVFROM:    return(dlg_from());
      case EVSUBJECT:   return(dlg_subject());
      case EVZHDR:    return(int_asc(dlg_hdrstyle()));
      case EVZNO: return(xl_no);
      case EVZYES:   return(xl_yes);
      case EVZTYPE:   return(dlg_hdr_type());
      case EVZDEST:   return(dest_address());
                case EVZHELLO:  return(Zhello);
                case EVZABORT:  return(Zabort);
                case EVZBYE:    return(Zbye);
                case EVZMORE:   return(Zmore);
                case EVZTOP:    return(Ztop);
      case EVZNEWTO:  return(Znewto);
      case EVZNEWSUB: return(Znewsub);
      case EVZWHO:    return(Zwhoports);
                case EVZQH:     return(Zqh);
                case EVZTO:     return(Zto);
                case EVZSUB:    return(Zsub);
                case EVZSP1:    return(Zsp1);
                case EVZSP2:    return(Zsp2);
                case EVZSP3:    return(Zsp3);
                case EVZSP4:    return(Zsp4);
      case EVZDIR:    return(Zdir);
      case EVZSREXX:  return(SpellPortName);
      case EVZSCHECK: return(SpellCheckCmd);
      case EVZSRUN:   return(SpellExecCmd);
      case EVZSEXIT:  return(SpellQuitCmd);
      case EVZFASK:   return(int_asc(Zfask));
      case EVZFTOPIC:     return(int_asc(Zftopic));
      case EVZFQUERY:     return(Zfquery);
                case EVXMSGCOLOR:   return(Xmsgcolor);
                case EVXQUOTECOLOR: return(Xquotecolor);
                case EVXHELPCOLOR:  return(Xhelpcolor);
                case EVXHBCOLOR:    return(Xhbcolor);
                case EVXWBCOLOR:    return(Xwbcolor);
                case EVXMLCOLOR:    return(Xmlcolor);
      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(getregg(result));
      case EVCMODE:  return(int_asc(curbp->b_mode));
      case EVGMODE:  return(int_asc(gmode));
      case EVTPAUSE: return(int_asc(term.t_pause));
      case EVPENDING:
            return(ltos(typahead()));
      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 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 EVSEARCHPNT: return(int_asc(searchtype));
      case EVDISPHIGH:return(ltos(disphigh));
      case EVPOPFLAG: return(ltos(popflag));
      case EVYANKFLAG:  return(ltos(yankflag));
                case EVSCRNAME:  return(dlg_get_filename());
      case EVCURWIND: return(int_asc(getcwnum()));
      case EVNUMWIND: return(int_asc(gettwnum()));
      case EVORGCOL: return(int_asc(term.t_colorg));
      case EVORGROW: return(int_asc(term.t_roworg));
   }
   meexit(-12);   /* again, we should never get here */
}
//-

/// gtfun()
/* evaluate a function
**
** char *fname;   name of function to evaluate
*****************/
char *REG gtfun(char *fname)
{
   register int fnum;      /* index to function to eval */
   register int arg;    /* value of some arguments */
   char arg1[NSTRING];     /* value of first argument */
   char arg2[NSTRING];     /* value of second argument */
   char arg3[NSTRING];     /* value of third argument */
   static char result[2 * NSTRING]; /* string result */

   /* 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 */
   fnum = binary(fname, funval, NFUNCS);

   /* return errorm on a bad reference */
   if (fnum == -1)
      return(errorm);

   /* 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:
            return("");
      case UFBIND:   return(transbind(arg1));
      case UFEXIST:  return(ltos(Exists(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), "");
      case UFISNUM:  return(ltos(is_num(arg1)));
   }

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

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

/// transbind()
/* string key name to binding name....
**
** char *skey;    name of key to get binding for
***************/
char *STD transbind(char *skey)
{
   CONST char *bindname;

   bindname = getfname(getbind(stock(skey)));
   if (bindname == NULL)
      bindname = errorm;

   return(bindname);
}
//-

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

   sp = s + strlen(s) - 1;

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

   *(sp+1) = 0;
   return(s);
}
//-

/// xlat
/* Filter a string through a translation table
**
** char *source;     string to filter
** char *lookup;     characters to translate
** char *trans;      resulting translated characters
******************/
char *REG xlat(char *source, char *lookup, char *trans)
{
   register char *sp;   /* pointer into source table */
   register char *lp;   /* pointer into lookup table */
   register char *rp;   /* pointer into result */
   static 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);
}
//-

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

/// getcwnum()
/* get current window number */
int STD getcwnum(void)
{
   register WINDOW *wp;
   register int num;

   num = 1;
   wp = wheadp;
   while (wp != curwp) {
      wp = wp->w_wndp;
      num++;
   }
   return(num);
}
//-

/// gettwnum()
/* get total window count */
int STD gettwnum()
{
   register WINDOW *wp;
   register int ctr;

   ctr = 0;
   wp = wheadp;
   while (wp) {
      ctr++;
      wp = wp->w_wndp;
   }
   return(ctr);
}
//-

/// getwpos()
/* get screen offset of current line in current window */
int STD getwpos(void)
{
   register int sline;  /* screen line from top of window */
   register LINE *lp;   /* scannile line pointer */

   /* search down the line we want */
   lp = curwp->w_linep;
   sline = 1;
   while (lp != curwp->w_dotp) {
      ++sline;
      lp = lforw(lp);
   }

   /* and return the value */
   return(sline);
}
//-

/// is_num()
/* is_num:  ascii string is integer......This is too
**    inconsistant to use the system's
*****************************************************/
int REG is_num(char *st)
{
   int period_flag;  /* have we seen a period yet? */

   /* skip preceding whitespace */
   while (*st == ' ' || *st == '\t')
      ++st;

   /* check for sign */
   if ((*st == '-') || (*st == '+'))
      ++st;

   /* scan digits */
   period_flag = FALSE;
   while ((*st >= '0') && (*st <= '9') ||
          (*st == '.' && period_flag == FALSE)) {
      if (*st == '.')
         period_flag = TRUE;
      st++;
   }

   /* scan rest of line for just white space */
   while (*st) {
      if ((*st != '\t') && (*st != ' '))
         return(FALSE);
      st++;
   }
   return(TRUE);
}
//-

/// setlower()
/* Set a character in the lowercase map
**
** char *ch;   /* ptr to character to set
** char *val;  /* value to set it to
******************************************/
int REG setlower(char *ch, char *val)
{
   return (int) (lowcase[*ch & 255] = *val & 255);
}
//-

/// setupper()
/* Set a character in the uppercase map
**
** char *ch;   ptr to character to set
** char *val;  value to set it to
**************/
int REG setupper(char *ch, char *val)
{
   return (int) (upcase[*ch & 255] = *val & 255);
}
//-

/// svar()
/* set a variable
**
** VDESC *var;    variable to set
** char *value;   value to set to
*****************/
int REG svar(VDESC *var, char *value)
{
   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 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);
      sp = malloc(strlen(value) + 1);
      if (sp == NULL)
         return(FALSE);
      strcpy(sp, value);
      uv[vnum].u_value = sp;
      break;

   case TKENV: /* set an environment variable */
      status = TRUE; /* by default */
      switch (vnum) {
          // ALAN: no longer allow fillcol to be set by EmacsFIG!
      case EVFILLCOL: //fillcol = asc_int(value);
            break;
      case EVPAGELEN:
            // xenolink bug workaround:  if user's setting is
            // larger than $pagelen, drop it down to $pagelen.
            // otherwise, use the user's smaller value.
            {
                int temp = asc_int(value)-1;
                if (temp < first_screen->s_nrow) {
               newsize(TRUE, temp+1);
                }
            }
            break;
      case EVCURCOL: status = setccol(asc_int(value));
            break;
      case EVCURLINE: status = gotoline(TRUE, asc_int(value));
            break;
      case EVFINI:   fini = stol(value);
            break;
      case EVQSTYLE:  quote_style = asc_int(value);
            break;
      case EVCURWIDTH:status = FALSE; /*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 EVDEBUG:  macbug = stol(value);
            break;
      case EVSTATUS: cmdstatus = stol(value);
            break;
      case EVAREAD:  xl_acc_read = asc_int(value);
            break;
      case EVAWRITE: xl_acc_write = asc_int(value);
            break;
      case EVZFASK:   Zfask = asc_int(value);
                      break;
      case EVZFTOPIC: Zftopic = 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();
            else
               linsert(1, (char)c);
            backchar(FALSE, 1);
            break;
      case EVDISCMD: discmd = stol(value);
            break;
      case EVKOOL:   kool = asc_int(value);
                      if (kool > sizeof(kool_array)-1) kool = 0;
            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(); /* Set up fast search arrays  */
            break;
      case EVREPLACE: strcpy(rpat, value);
            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 EVLINE:   putctext(value);
            break;
      case EVGFLAGS: gflags = asc_int(value);
            break;
      case EVREADHK: setkey(&readhook, value);
            break;
      case EVWRAPHK: setkey(&wraphook, value);
            break;
      case EVCMDHK:  setkey(&cmdhook, 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 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, value);
            break;
      case EVEXBHOOK: setkey(&exbhook, value);
            break;
      case EVWRITEHK: setkey(&writehook, value);
            break;
      case EVSEARCHPNT: searchtype = asc_int(value);
            if (searchtype < SRNORM  || searchtype > SREND)
               searchtype = SRNORM;
            break;
      case EVDISPHIGH:
            c = disphigh;
            disphigh = stol(value);
            if (c != disphigh)
               upwind();
            break;
      case EVPOPFLAG: popflag = stol(value);
            break;
      case EVYANKFLAG:  yankflag = stol(value);
            break;
      case EVCURWIND:   nextwind(TRUE, asc_int(value));
            break;
      case EVNUMWIND:   break;
      case EVTO:
            newrecipient(value);
            break;
      case EVFROM:
            break;
      case EVSUBJECT:
            newsubject(value);
            break;
      case EVZNO:
            newzno(value);
            break;
      case EVZYES:
            newzyes(value);
            break;
      case EVTEXT8:
            newpromptstring(&TEXT8, value); break;
      case EVTEXT9:
            newpromptstring(&TEXT9, value); break;
      case EVTEXT19:
            newpromptstring(&TEXT19, value); break;
      case EVTEXT70:
            newpromptstring(&TEXT70, value); break;
      case EVTEXT76:
            newpromptstring(&TEXT76, value); break;
      case EVTEXT78:
            newpromptstring(&TEXT78, value); break;
      case EVTEXT79:
            newpromptstring(&TEXT79, value); break;
      case EVTEXT81:
            newpromptstring(&TEXT81, value); break;
      case EVTEXT84:
            newpromptstring(&TEXT84, value); break;
      case EVTEXT86:
            newpromptstring(&TEXT86, value); break;
      case EVTEXT109:
            newpromptstring(&TEXT109, value); break;
      case EVTEXT148:
            newpromptstring(&TEXT148, value); break;
      case EVZHELLO:
          newpromptstring(&Zhello, value); break;
      case EVZABORT:
          newpromptstring(&Zabort, value); break;
      case EVZBYE:
          newpromptstring(&Zbye, value); break;
      case EVZMORE:
          newpromptstring(&Zmore, value); break;
      case EVZTOP:
          newpromptstring(&Ztop, value); break;
      case EVZQH:
          newpromptstring(&Zqh, value); break;
      case EVZTO:
          newpromptstring(&Zto, value); break;
      case EVZSUB:
          newpromptstring(&Zsub, value); break;
      case EVZNEWTO:
          newpromptstring(&Znewto, value); break;
      case EVZNEWSUB:
          newpromptstring(&Znewsub, value); break;
      case EVZWHO:
          newpromptstring(&Zwhoports, value); break;
      case EVZSP1:
          newpromptstring(&Zsp1, value); break;
      case EVZSP2:
          newpromptstring(&Zsp2, value); break;
      case EVZSP3:
          newpromptstring(&Zsp3, value); break;
      case EVZSP4:
          newpromptstring(&Zsp4, value); break;
      case EVZDIR:
          newpromptstring(&Zdir, value); break;
      case EVZFQUERY:
          newpromptstring(&Zfquery, value); break;
                case EVXMSGCOLOR:
          newpromptstring(&Xmsgcolor, value); break;
                case EVXQUOTECOLOR:
          newpromptstring(&Xquotecolor, value); break;
                case EVXHELPCOLOR:
          newpromptstring(&Xhelpcolor, value); break;
                case EVXHBCOLOR:
          newpromptstring(&Xhbcolor, value); break;
                case EVXWBCOLOR:
          newpromptstring(&Xwbcolor, value); break;
                case EVXMLCOLOR:
          newpromptstring(&Xmlcolor, value); break;
      case EVZSREXX:
          newpromptstring(&SpellPortName, value); break;
      case EVZSCHECK:
          newpromptstring(&SpellCheckCmd, value); break;
      case EVZSRUN:
          newpromptstring(&SpellExecCmd, value); break;
      case EVZSEXIT:
          newpromptstring(&SpellQuitCmd, value); break;
      }
      break;
   }
   return(status);
}
//-

/// setkey()
/*
** set a KEYTAB to the given name of the given type
****************************************************/
int setkey(KEYTAB *key, char *name)
{
   int (* STD ktemp)(); /* temp function pointer to assign */
   register BUFFER *kmacro;   /* ptr to buffer of macro to bind to key */
   char bufn[NBUFN];    /* buffer to hold macro name */

   /* are we unbinding it? */
   if (*name == 0) {
      key->k_type = BINDNUL;
      return(TRUE);
   }

   /* bind to a built in function? */
   if ((ktemp = fncmatch(name)) != NULL) {
      key->k_ptr.fp = ktemp;
      key->k_type = BINDFNC;
      return(TRUE);
   }

   /* is it a procedure/macro? */
   strcpy(bufn, "[");
   strcat(bufn, name);
   strcat(bufn, "]");
   if ((kmacro=bfind(bufn, FALSE, 0)) != NULL) {
      key->k_ptr.buf = kmacro;
      key->k_type = BINDBUF;
      return(TRUE);
   }

   /* not anything we can bind to */
   mlwrite(TEXT16);
/*    "[No such function]" */
   return(FALSE);
}
//-

/// findvar()
/*
** find a variables type and name
**
** char *var;     name of var to get
** VDESC *vd;     structure to hold type and ptr
** int size;      size of var array
**
 ***********************************************************************/
REG findvar(char *var, VDESC *vd, int size)
{
   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;
   return(1);
}
//-

/// newsize()
/* resize the screen, re-writing the screen */
STD newsize(int f, int n)
{
   WINDOW *wp; /* current window being examined */
   WINDOW *nextwp; /* next window to scan */
   WINDOW *lastwp; /* last window scanned */
   int lastline;  /* screen line of last line of current window */
   int cmark;     /* current mark */

   /* if the command defaults, assume the largest */
   if (f == FALSE)
      n = term.t_mrow + 1;

   /* make sure it's in range */
   if (n < 3 || n > term.t_mrow + 1) {
      mlwrite(TEXT209);
/*       "%%Screen size out of range" */
      return(FALSE);
   }

   if (term.t_nrow == n - 1)
      return(TRUE);
   else if (term.t_nrow < n - 1) {

      /* go to the last window */
      wp = wheadp;
      while (wp->w_wndp != NULL)
         wp = wp->w_wndp;

      /* and enlarge it as needed */
      wp->w_ntrows = n - wp->w_toprow - 2;
      wp->w_flag |= WFHARD|WFMODE;

   } else {

      /* rebuild the window structure */
      nextwp = wheadp;
      wp = NULL;
      lastwp = NULL;
      while (nextwp != NULL) {
         wp = nextwp;
         nextwp = wp->w_wndp;

         /* get rid of it if it is too low */
         if (wp->w_toprow > n - 2) {

            /* save the point/mark if needed */
            if (--wp->w_bufp->b_nwnd == 0) {
               wp->w_bufp->b_dotp = wp->w_dotp;
               wp->w_bufp->b_doto = wp->w_doto;
               for (cmark = 0; cmark < NMARKS; cmark++) {
                  wp->w_bufp->b_markp[cmark] = wp->w_markp[cmark];
                  wp->w_bufp->b_marko[cmark] = wp->w_marko[cmark];
               }
               wp->w_bufp->b_fcol = wp->w_fcol;
            }

            /* update curwp and lastwp if needed */
            if (wp == curwp)
               curwp = wheadp;
               curbp = curwp->w_bufp;
            if (lastwp != NULL)
               lastwp->w_wndp = NULL;

            /* free the structure */
            free((char *)wp);
            wp = NULL;

         } else {
            /* need to change this window size? */
            lastline = wp->w_toprow + wp->w_ntrows - 1;
            if (lastline >= n - 2) {
               wp->w_ntrows = n - wp->w_toprow - 2;
               wp->w_flag |= WFHARD|WFMODE;
            }
         }

         lastwp = wp;
      }
   }

   /* screen is garbage */
   term.t_nrow = n - 1;
   sgarbf = TRUE;
   return(TRUE);
}
//-

/// putctext
/*
** putctext:   replace the current line with the passed in text
**
** char *iline;      contents of new line
 ***********************************************************************/
STD putctext(char *iline)
{
   register int status;

   /* delete the current line */
   curwp->w_doto = 0;   /* starting at the beginning of the line */
   if ((status = killtext(TRUE, 1)) != TRUE)
      return(status);

   /* insert the new line */
   if ((status = linstr(iline)) != TRUE)
      return(status);
   status = lnewline();
   backline(TRUE, 1);
   return(status);
}
//-

/// setccol()
/*
** Set current column.
**
** int pos;    position to set cursor
**
 ***********************************************************************/
STD setccol(int pos)
{
        register int c;    /* character being scanned */
   register int i;      /* index into current line */
   register int col; /* current cursor column   */
   register int llen;   /* length of line in bytes */

   col = 0;
   llen = llength(curwp->w_dotp);

   /* scan the line until we are at or past the target column */
   for (i = 0; i < llen; ++i) {
      /* upon reaching the target, drop out */
      if (col >= pos)
         break;

      /* advance one character */
                c = lgetc(curwp->w_dotp, i);
                if (c == '\t')
                        col += -(col % tabsize) + (tabsize - 1);
                else if (c<0x20 || c==0x7F)
                        ++col;
                ++col;
        }

   /* set us at the new position */
   curwp->w_doto = i;

   /* and tell weather we made it */
   return(col >= pos);
}
//-


