Relay-Version: version B 2.10 5/3/83; site utzoo.UUCP Path: utzoo!utgpu!water!watmath!clyde!rutgers!husc6!sri-unix!ctnews!pyramid!uccba!hal!ncoast!allbery From: allbery@ncoast.UUCP Newsgroups: comp.sources.misc Subject: memacs 3.8i 4 of 11 Message-ID: <2659@ncoast.UUCP> Date: Mon, 15-Jun-87 14:59:39 EDT Article-I.D.: ncoast.2659 Posted: Mon Jun 15 14:59:39 1987 Date-Received: Sat, 20-Jun-87 02:25:42 EDT Sender: allbery@ncoast.UUCP Lines: 2613 Approved: allbery@ncoast.UUCP : #!/bin/sh # shar+ created from directory /usr2/davidsen/emacs38i # 13:42 on Thu Jun 11, 1987 by davidsen echo 'x - eval.c (text)' sed << 'E!O!F' 's/^X//' > eval.c X/* EVAL.C: Expresion evaluation functions for X MicroEMACS X X written 1986 by Daniel Lawrence */ X X#include X#include "estruct.h" X#include "edef.h" X#include "evar.h" X Xchar value[NSTRING]; /* buffer to return value in */ X Xvarinit() /* initialize the user variable list */ X X{ X register int i; X X for (i=0; i < MAXVARS; i++) X uv[i].u_name[0] = 0; X} X Xchar *gtfun(fname) /* evaluate a function */ X Xchar *fname; /* name of function to evaluate */ X X{ X register int fnum; /* index to function to eval */ X register int status; /* return status */ X char arg1[NSTRING]; /* value of first argument */ X char arg2[NSTRING]; /* value of second argument */ X char arg3[NSTRING]; /* value of third argument */ X static char result[2 * NSTRING]; /* string result */ X X /* look the function up in the function table */ X fname[3] = 0; /* only first 3 chars significant */ X mklower(fname); /* and let it be upper or lower case */ X for (fnum = 0; fnum < NFUNCS; fnum++) X if (strcmp(fname, funcs[fnum].f_name) == 0) X break; X X /* return errorm on a bad reference */ X if (fnum == NFUNCS) X return(errorm); X X /* if needed, retrieve the first argument */ X if (funcs[fnum].f_type >= MONAMIC) { X if ((status = macarg(arg1)) != TRUE) X return(errorm); X X /* if needed, retrieve the second argument */ X if (funcs[fnum].f_type >= DYNAMIC) { X if ((status = macarg(arg2)) != TRUE) X return(errorm); X X /* if needed, retrieve the third argument */ X if (funcs[fnum].f_type >= TRINAMIC) X if ((status = macarg(arg3)) != TRUE) X return(errorm); X } X } X X X /* and now evaluate it! */ X switch (fnum) { X case UFADD: return(itoa(atoi(arg1) + atoi(arg2))); X case UFSUB: return(itoa(atoi(arg1) - atoi(arg2))); X case UFTIMES: return(itoa(atoi(arg1) * atoi(arg2))); X case UFDIV: return(itoa(atoi(arg1) / atoi(arg2))); X case UFMOD: return(itoa(atoi(arg1) % atoi(arg2))); X case UFNEG: return(itoa(-atoi(arg1))); X case UFCAT: strcpy(result, arg1); X return(strcat(result, arg2)); X case UFLEFT: return(strncpy(result, arg1, atoi(arg2))); X case UFRIGHT: return(strcpy(result, &arg1[atoi(arg2)-1])); X case UFMID: return(strncpy(result, &arg1[atoi(arg2)-1], X atoi(arg3))); X case UFNOT: return(ltos(stol(arg1) == FALSE)); X case UFEQUAL: return(ltos(atoi(arg1) == atoi(arg2))); X case UFLESS: return(ltos(atoi(arg1) < atoi(arg2))); X case UFGREATER: return(ltos(atoi(arg1) > atoi(arg2))); X case UFSEQUAL: return(ltos(strcmp(arg1, arg2) == 0)); X case UFSLESS: return(ltos(strcmp(arg1, arg2) < 0)); X case UFSGREAT: return(ltos(strcmp(arg1, arg2) > 0)); X case UFIND: return(getval(arg1)); X case UFAND: return(ltos(stol(arg1) && stol(arg2))); X case UFOR: return(ltos(stol(arg1) || stol(arg2))); X case UFLENGTH: return(itoa(strlen(arg1))); X case UFUPPER: return(mkupper(arg1)); X case UFLOWER: return(mklower(arg1)); X case UFTRUTH: return(ltos(atoi(arg1) == 42)); X case UFASCII: return(itoa((int)arg1[0])); X case UFCHR: result[0] = atoi(arg1); X result[1] = 0; X return(result); X case UFGTKEY: result[0] = tgetc(); X result[1] = 0; X return(result); X case UFRND: return(itoa((ernd() % abs(atoi(arg1))) + 1)); X case UFABS: return(itoa(abs(atoi(arg1)))); X } X X exit(-11); /* never should get here */ X} X Xchar *gtusr(vname) /* look up a user var's value */ X Xchar *vname; /* name of user variable to fetch */ X X{ X X register int vnum; /* ordinal number of user var */ X X /* scan the list looking for the user var name */ X for (vnum = 0; vnum < MAXVARS; vnum++) X if (strcmp(vname, uv[vnum].u_name) == 0) X break; X X /* return errorm on a bad reference */ X if (vnum == MAXVARS) X return(errorm); X X return(uv[vnum].u_value); X} X Xchar *gtenv(vname) X Xchar *vname; /* name of environment variable to retrieve */ X X{ X register int vnum; /* ordinal number of var refrenced */ X X /* scan the list, looking for the referenced name */ X for (vnum = 0; vnum < NEVARS; vnum++) X if (strcmp(vname, envars[vnum]) == 0) X break; X X /* return errorm on a bad reference */ X if (vnum == NEVARS) X return(errorm); X X /* otherwise, fetch the appropriate value */ X switch (vnum) { X case EVFILLCOL: return(itoa(fillcol)); X case EVPAGELEN: return(itoa(term.t_nrow + 1)); X case EVCURCOL: return(itoa(getccol(FALSE) + 1)); X case EVCURLINE: return(itoa(getcline())); X case EVRAM: return(itoa((int)(envram / 1024l))); X case EVFLICKER: return(ltos(flickcode)); X case EVCURWIDTH:return(itoa(term.t_nrow)); X case EVCBUFNAME:return(curbp->b_bname); X case EVCFNAME: return(curbp->b_fname); X case EVSRES: return(sres); X case EVDEBUG: return(ltos(macbug)); X case EVSTATUS: return(ltos(cmdstatus)); X case EVPALETTE: return(palstr); X case EVASAVE: return(itoa(gasave)); X case EVACOUNT: return(itoa(gacount)); X case EVLASTKEY: return(itoa(lastkey)); X case EVCURCHAR: return(itoa( X lgetc(curwp->w_dotp,curwp->w_doto))); X case EVDISCMD: return(ltos(discmd)); X case EVVERSION: return(VERSION); X case EVPROGNAME:return(PROGNAME); X case EVSEED: return(itoa(seed)); X case EVDISINP: return(ltos(disinp)); X } X exit(-12); /* again, we should never get here */ X} X Xint setvar(f, n) /* set a variable */ X Xint f; /* default flag */ Xint n; /* numeric arg (can overide prompted value) */ X X{ X register int vnum; /* ordinal number of var refrenced */ X register int status; /* status return */ X register int vtype; /* type of variable to set */ X register int c; /* translated character */ X register char * sp; /* scratch string pointer */ X char var[NVSIZE+1]; /* name of variable to fetch */ X char value[NSTRING]; /* value to set variable to */ X X /* first get the variable to set.. */ X if (clexec == FALSE) { X status = mlreply("Variable to set: ", &var[0], NVSIZE); X if (status != TRUE) X return(status); X } else { /* macro line argument */ X /* grab token and skip it */ X execstr = token(execstr, var); X } X X /* check the legality and find the var */ Xsv01: vtype = -1; X switch (var[0]) { X X case '$': /* check for legal enviromnent var */ X for (vnum = 0; vnum < NEVARS; vnum++) X if (strcmp(&var[1], envars[vnum]) == 0) { X vtype = TKENV; X break; X } X break; X X case '%': /* check for existing legal user variable */ X for (vnum = 0; vnum < MAXVARS; vnum++) X if (strcmp(&var[1], uv[vnum].u_name) == 0) { X vtype = TKVAR; X break; X } X if (vnum < MAXVARS) X break; X X /* create a new one??? */ X for (vnum = 0; vnum < MAXVARS; vnum++) X if (uv[vnum].u_name[0] == 0) { X vtype = TKVAR; X strcpy(uv[vnum].u_name, &var[1]); X break; X } X break; X X case '&': /* indirect operator? */ X var[4] = 0; X if (strcmp(&var[1], "ind") == 0) { X /* grab token, and eval it */ X execstr = token(execstr, var); X strcpy(var, getval(var)); X goto sv01; X } X } X X /* if its not legal....bitch */ X if (vtype == -1) { X mlwrite("%%No such variable"); X return(FALSE); X } X X /* get the value for that variable */ X if (f == TRUE) X strcpy(value, itoa(n)); X else { X status = mlreply("Value: ", &value[0], NSTRING); X if (status != TRUE) X return(status); X } X X /* and set the appropriate value */ X status = TRUE; X switch (vtype) { X case TKVAR: /* set a user variable */ X if (uv[vnum].u_value != NULL) X free(uv[vnum].u_value); X sp = malloc(strlen(value) + 1); X if (sp == NULL) X return(FALSE); X strcpy(sp, value); X uv[vnum].u_value = sp; X break; X X case TKENV: /* set an environment variable */ X status = TRUE; /* by default */ X switch (vnum) { X case EVFILLCOL: fillcol = atoi(value); X break; X case EVPAGELEN: status = newsize(TRUE, atoi(value)); X break; X case EVCURCOL: status = setccol(atoi(value)); X break; X case EVCURLINE: status = gotoline(TRUE, atoi(value)); X break; X case EVRAM: break; X case EVFLICKER: flickcode = stol(value); X break; X case EVCURWIDTH:status = newwidth(TRUE, atoi(value)); X break; X case EVCBUFNAME:strcpy(curbp->b_bname, value); X curwp->w_flag |= WFMODE; X break; X case EVCFNAME: strcpy(curbp->b_fname, value); X curwp->w_flag |= WFMODE; X break; X case EVSRES: status = TTrez(value); X break; X case EVDEBUG: macbug = stol(value); X break; X case EVSTATUS: cmdstatus = stol(value); X break; X case EVPALETTE: strncpy(palstr, value, 48); X spal(palstr); X break; X case EVASAVE: gasave = atoi(value); X break; X case EVACOUNT: gacount = atoi(value); X break; X case EVLASTKEY: lastkey = atoi(value); X break; X case EVCURCHAR: ldelete(1, FALSE); /* delete 1 char */ X c = atoi(value); X if (c == '\n') X lnewline(FALSE, 1); X else X linsert(1, c); X break; X case EVDISCMD: discmd = stol(value); X break; X case EVVERSION: break; X case EVPROGNAME:break; X case EVSEED: seed = atoi(value); X break; X case EVDISINP: disinp = stol(value); X break; X } X break; X } X return(status); X} X X/* atoi: ascii string to integer......This is too X inconsistant to use the system's */ X Xatoi(st) X Xchar *st; X X{ X int result; /* resulting number */ X int sign; /* sign of resulting number */ X char c; /* current char being examined */ X X result = 0; X sign = 1; X X /* skip preceding whitespace */ X while (*st == ' ' || *st == '\t') X ++st; X X /* check for sign */ X if (*st == '-') { X sign = -1; X ++st; X } X if (*st == '+') X ++st; X X /* scan digits, build value */ X while ((c = *st++)) X if (c >= '0' && c <= '9') X result = result * 10 + c - '0'; X else X return(0); X X return(result * sign); X} X X/* itoa: integer to ascii string.......... This is too X inconsistant to use the system's */ X Xchar *itoa(i) X Xint i; /* integer to translate to a string */ X X{ X register int digit; /* current digit being used */ X register char *sp; /* pointer into result */ X register int sign; /* sign of resulting number */ X static char result[INTWIDTH+1]; /* resulting string */ X X /* eliminate the trivial 0 */ X if (i == 0) X return("0"); X X /* record the sign...*/ X sign = 1; X if (i < 0) { X sign = -1; X i = -i; X } X X /* and build the string (backwards!) */ X sp = result + INTWIDTH; X *sp = 0; X while (i) { X digit = i % 10; X *(--sp) = '0' + digit; /* and install the new digit */ X i = i / 10; X } X X /* and fix the sign */ X if (sign == -1) { X *(--sp) = '-'; /* and install the minus sign */ X } X X return(sp); X} X Xint gettyp(token) /* find the type of a passed token */ X Xchar *token; /* token to analyze */ X X{ X register char c; /* first char in token */ X X /* grab the first char (this is all we need) */ X c = *token; X X /* no blanks!!! */ X if (c == 0) X return(TKNUL); X X /* a numeric literal? */ X if (c >= '0' && c <= '9') X return(TKLIT); X X switch (c) { X case '"': return(TKSTR); X X case '!': return(TKDIR); X case '@': return(TKARG); X case '#': return(TKBUF); X case '$': return(TKENV); X case '%': return(TKVAR); X case '&': return(TKFUN); X case '*': return(TKLBL); X X default: return(TKCMD); X } X} X Xchar *getval(token) /* find the value of a token */ X Xchar *token; /* token to evaluate */ X X{ X register int status; /* error return */ X register BUFFER *bp; /* temp buffer pointer */ X register int blen; /* length of buffer argument */ X char pad[20]; /* pad 20 bytes on stack for safety */ X char buf[NSTRING]; /* string buffer for some returns */ X X switch (gettyp(token)) { X case TKNUL: return(""); X X case TKARG: /* interactive argument */ X strcpy(token, getval(&token[1])); X status = getstring(token, X buf, NSTRING, ctoec('\n')); X if (status == ABORT) X return(errorm); X return(buf); X X case TKBUF: /* buffer contents fetch */ X X /* grab the right buffer */ X strcpy(token, getval(&token[1])); X bp = bfind(token, FALSE, 0); X if (bp == NULL) X return(errorm); X X /* if the buffer is displayed, get the window X vars instead of the buffer vars */ X if (bp->b_nwnd > 0) { X curbp->b_dotp = curwp->w_dotp; X curbp->b_doto = curwp->w_doto; X } X X /* make sure we are not at the end */ X if (bp->b_linep == bp->b_dotp) X return(errorm); X X /* grab the line as an argument */ X blen = bp->b_dotp->l_used - bp->b_doto; X if (blen > NSTRING) X blen = NSTRING; X strncpy(buf, bp->b_dotp->l_text + bp->b_doto, X blen); X buf[blen] = 0; X X /* and step the buffer's line ptr ahead a line */ X bp->b_dotp = bp->b_dotp->l_fp; X bp->b_doto = 0; X X /* if displayed buffer, reset window ptr vars*/ X if (bp->b_nwnd > 0) { X curwp->w_dotp = curbp->b_dotp; X curwp->w_doto = 0; X curwp->w_flag |= WFMOVE; X } X X /* and return the spoils */ X return(buf); X X case TKVAR: return(gtusr(token+1)); X case TKENV: return(gtenv(token+1)); X case TKFUN: return(gtfun(token+1)); X case TKDIR: return(errorm); X case TKLBL: return(itoa(gtlbl(token))); X case TKLIT: return(token); X case TKSTR: return(token+1); X case TKCMD: return(token); X } X} X Xgtlbl(token) /* find the line number of the given label */ X Xchar *token; /* label name to find */ X X{ X return(1); X} X Xint stol(val) /* convert a string to a numeric logical */ X Xchar *val; /* value to check for stol */ X X{ X /* check for logical values */ X if (val[0] == 'F') X return(FALSE); X if (val[0] == 'T') X return(TRUE); X X /* check for numeric truth (!= 0) */ X return((atoi(val) != 0)); X} X Xchar *ltos(val) /* numeric logical to string logical */ X Xint val; /* value to translate */ X X{ X if (val) X return(truem); X else X return(falsem); X} X Xchar *mkupper(str) /* make a string upper case */ X Xchar *str; /* string to upper case */ X X{ X char *sp; X X sp = str; X while (*sp) { X if ('a' <= *sp && *sp <= 'z') X *sp += 'A' - 'a'; X ++sp; X } X return(str); X} X Xchar *mklower(str) /* make a string lower case */ X Xchar *str; /* string to lower case */ X X{ X char *sp; X X sp = str; X while (*sp) { X if ('A' <= *sp && *sp <= 'Z') X *sp += 'a' - 'A'; X ++sp; X } X return(str); X} X Xint abs(x) /* take the absolute value of an integer */ X Xint x; X X{ X return(x < 0 ? -x : x); X} X Xint ernd() /* returns a random integer */ X X{ X seed = abs(seed * 1721 + 10007); X return(seed); X} E!O!F newsize=`wc -c < eval.c` if [ $newsize -ne 13772 ] then echo "File eval.c was $newsize bytes, 13772 expected" fi echo 'x - evar.h (text)' sed << 'E!O!F' 's/^X//' > evar.h X/* EVAR.H: Environment and user variable definitions X for MicroEMACS X X written 1986 by Daniel Lawrence X*/ X X/* structure to hold user variables and their definitions */ X Xtypedef struct UVAR { X char u_name[NVSIZE + 1]; /* name of user variable */ X char *u_value; /* value (string) */ X} UVAR; X X/* current user variables (This structure will probably change) */ X X#define MAXVARS 100 X XUVAR uv[MAXVARS]; /* user variables */ X X/* list of recognized environment variables */ X Xchar *envars[] = { X "fillcol", /* current fill column */ X "pagelen", /* number of lines used by editor */ X "curcol", /* current column pos of cursor */ X "curline", /* current line in file */ X "ram", /* ram in use by malloc */ X "flicker", /* flicker supression */ X "curwidth", /* current screen width */ X "cbufname", /* current buffer name */ X "cfname", /* current file name */ X "sres", /* current screen resolution */ X "debug", /* macro debugging */ X "status", /* returns the status of the last command */ X "palette", /* current palette string */ X "asave", /* # of chars between auto-saves */ X "acount", /* # of chars until next auto-save */ X "lastkey", /* last keyboard char struck */ X "curchar", /* current character under the cursor */ X "discmd", /* display commands on command line */ X "version", /* current version number */ X "progname", /* returns current prog name - "MicroEMACS" */ X "seed", /* current random number seed */ X "disinp", /* display command line input characters */ X}; X X#define NEVARS sizeof(envars) / sizeof(char *) X X/* and its preprocesor definitions */ X X#define EVFILLCOL 0 X#define EVPAGELEN 1 X#define EVCURCOL 2 X#define EVCURLINE 3 X#define EVRAM 4 X#define EVFLICKER 5 X#define EVCURWIDTH 6 X#define EVCBUFNAME 7 X#define EVCFNAME 8 X#define EVSRES 9 X#define EVDEBUG 10 X#define EVSTATUS 11 X#define EVPALETTE 12 X#define EVASAVE 13 X#define EVACOUNT 14 X#define EVLASTKEY 15 X#define EVCURCHAR 16 X#define EVDISCMD 17 X#define EVVERSION 18 X#define EVPROGNAME 19 X#define EVSEED 20 X#define EVDISINP 21 X X/* list of recognized user functions */ X Xtypedef struct UFUNC { X char *f_name; /* name of function */ X int f_type; /* 1 = monamic, 2 = dynamic */ X} UFUNC; X X#define NILNAMIC 0 X#define MONAMIC 1 X#define DYNAMIC 2 X#define TRINAMIC 3 X XUFUNC funcs[] = { X "add", DYNAMIC, /* add two numbers together */ X "sub", DYNAMIC, /* subtraction */ X "tim", DYNAMIC, /* multiplication */ X "div", DYNAMIC, /* division */ X "mod", DYNAMIC, /* mod */ X "neg", MONAMIC, /* negate */ X "cat", DYNAMIC, /* concatinate string */ X "lef", DYNAMIC, /* left string(string, len) */ X "rig", DYNAMIC, /* right string(string, pos) */ X "mid", TRINAMIC, /* mid string(string, pos, len) */ X "not", MONAMIC, /* logical not */ X "equ", DYNAMIC, /* logical equality check */ X "les", DYNAMIC, /* logical less than */ X "gre", DYNAMIC, /* logical greater than */ X "seq", DYNAMIC, /* string logical equality check */ X "sle", DYNAMIC, /* string logical less than */ X "sgr", DYNAMIC, /* string logical greater than */ X "ind", MONAMIC, /* evaluate indirect value */ X "and", DYNAMIC, /* logical and */ X "or", DYNAMIC, /* logical or */ X "len", MONAMIC, /* string length */ X "upp", MONAMIC, /* uppercase string */ X "low", MONAMIC, /* lower case string */ X "tru", MONAMIC, /* Truth of the universe logical test */ X "asc", MONAMIC, /* char to integer conversion */ X "chr", MONAMIC, /* integer to char conversion */ X "gtk", NILNAMIC, /* get 1 charater */ X "rnd", MONAMIC, /* get a random number */ X "abs", MONAMIC, /* absolute value of a number */ X}; X X#define NFUNCS sizeof(funcs) / sizeof(UFUNC) X X/* and its preprocesor definitions */ X X#define UFADD 0 X#define UFSUB 1 X#define UFTIMES 2 X#define UFDIV 3 X#define UFMOD 4 X#define UFNEG 5 X#define UFCAT 6 X#define UFLEFT 7 X#define UFRIGHT 8 X#define UFMID 9 X#define UFNOT 10 X#define UFEQUAL 11 X#define UFLESS 12 X#define UFGREATER 13 X#define UFSEQUAL 14 X#define UFSLESS 15 X#define UFSGREAT 16 X#define UFIND 17 X#define UFAND 18 X#define UFOR 19 X#define UFLENGTH 20 X#define UFUPPER 21 X#define UFLOWER 22 X#define UFTRUTH 23 X#define UFASCII 24 X#define UFCHR 25 X#define UFGTKEY 26 X#define UFRND 27 X#define UFABS 28 E!O!F newsize=`wc -c < evar.h` if [ $newsize -ne 4174 ] then echo "File evar.h was $newsize bytes, 4174 expected" fi echo 'x - exec.c (text)' sed << 'E!O!F' 's/^X//' > exec.c X/* This file is for functions dealing with execution of X commands, command lines, buffers, files and startup files X X written 1986 by Daniel Lawrence */ X X#include X#include "estruct.h" X#include "edef.h" X X#if MEGAMAX & ST520 Xoverlay "exec" X#endif X X#if DEBUGM Xchar outline[NSTRING]; /* global string to hold debug line text */ X#endif X X/* namedcmd: execute a named command even if it is not bound */ X Xnamedcmd(f, n) X Xint f, n; /* command arguments [passed through to command executed] */ X X{ X register (*kfunc)(); /* ptr to the requexted function to bind to */ X int (*getname())(); X X /* prompt the user to type a named command */ X mlwrite(": "); X X /* and now get the function name to execute */ X kfunc = getname(); X if (kfunc == NULL) { X mlwrite("[No such function]"); X return(FALSE); X } X X /* and then execute the command */ X return((*kfunc)(f, n)); X} X X/* execcmd: Execute a command line command to be typed in X by the user */ X Xexeccmd(f, n) X Xint f, n; /* default Flag and Numeric argument */ X X{ X register int status; /* status return */ X char cmdstr[NSTRING]; /* string holding command to execute */ X X /* get the line wanted */ X if ((status = mlreply(": ", cmdstr, NSTRING)) != TRUE) X return(status); X X execlevel = 0; X return(docmd(cmdstr)); X} X X/* docmd: take a passed string as a command line and translate X it to be executed as a command. This function will be X used by execute-command-line and by all source and X startup files. Lastflag/thisflag is also updated. X X format of the command line is: X X {# arg} {} X X Directives start with a "!" and include: X X !endm End a macro X !if (cond) conditional execution X !else X !endif X !return Return (terminating current macro) X !goto