home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Usenet 1994 January
/
usenetsourcesnewsgroupsinfomagicjanuary1994.iso
/
sources
/
misc
/
volume1
/
8706
/
16
< prev
next >
Wrap
Internet Message Format
|
1993-09-01
|
64KB
From mipos3!intelca!oliveb!pyramid!uccba!hal!ncoast!allbery Fri Jun 19 14:06:26 PDT 1987
Article 9 of comp.sources.misc:
Path: td2cad!mipos3!intelca!oliveb!pyramid!uccba!hal!ncoast!allbery
>From: davidsen@steinmetz.UUCP (William E. Davidsen Jr)
Newsgroups: comp.sources.misc
Subject: memacs 3.8i 4 of 11
Message-ID: <2659@ncoast.UUCP>
Date: 15 Jun 87 18:59:39 GMT
Sender: allbery@ncoast.UUCP
Lines: 2613
Approved: allbery@ncoast.UUCP
X-Archive: comp.sources.misc/8706/16
:
#!/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 <stdio.h>
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 <stdio.h>
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} <command-name> {<argument string(s)>}
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 <label> Jump to a label in the current macro
X
X Line Labels begin with a "*" in column 1, like:
X
X *LBL01
X*/
X
Xdocmd(cline)
X
Xchar *cline; /* command line to execute */
X
X{
X register int f; /* default argument flag */
X register int n; /* numeric repeat value */
X register int i;
X int (*fnc)(); /* function to execute */
X int status; /* return status of function */
X int oldcle; /* old contents of clexec flag */
X int llen; /* length of cline */
X int force; /* force TRUE result? */
X char *tmp; /* tmp pointer into cline */
X struct LINE *lp; /* a line pointer */
X char *oldestr; /* original exec string */
X char token[NSTRING]; /* next token off of command line */
X int (*fncmatch())();
X#if DEBUGM
X /* if $debug == TRUE, every line to execute
X gets echoed and a key needs to be pressed to continue
X ^G will abort the command */
X register char *sp; /* pointer into buf to expand %s */
X
X if (macbug) {
X strcpy(outline, "<<<");
X#if 1 /* debug if levels */
X strcat(outline, itoa(execlevel));
X strcat(outline, ":");
X#endif
X strcat(outline, cline);
X strcat(outline, ">>>");
X
X /* change all '%' to ':' so mlwrite won't expect arguments */
X sp = outline;
X while (*sp) {
X if (*sp++ == '%')
X *(sp-1) = ':';
X }
X
X /* write out the debug line */
X mlwrite(outline);
X update(TRUE);
X
X /* and get the keystroke */
X if (tgetc() == 7) {
X mlwrite("[Macro aborted]");
X return(FALSE);
X }
X }
X#endif
X
X /* dump comments here */
X if (*cline == ';')
X return(TRUE);
X
X /* eat leading spaces */
X while (*cline == ' ' || *cline == '\t')
X ++cline;
X
X /* check to see if this line turns macro storage off */
X if (cline[0] == '!' && strncmp(&cline[1], "endm", 4) == 0) {
X mstore = FALSE;
X bstore = NULL;
X return(TRUE);
X }
X
X /* if macro store is on, just salt this away */
X if (mstore) {
X /* allocate the space for the line */
X llen = strlen(cline);
X if ((lp=lalloc(llen)) == NULL) {
X mlwrite("Out of memory while storing macro");
X return (FALSE);
X }
X
X /* copy the text into the new line */
X for (i=0; i<llen; ++i)
X lputc(lp, i, cline[i]);
X
X /* attach the line to the end of the buffer */
X bstore->b_linep->l_bp->l_fp = lp;
X lp->l_bp = bstore->b_linep->l_bp;
X bstore->b_linep->l_bp = lp;
X lp->l_fp = bstore->b_linep;
X return (TRUE);
X }
X
X /* dump labels here */
X if (*cline == '*')
X return(TRUE);
X
X force = FALSE;
X oldestr = execstr; /* save last ptr to string to execute */
X execstr = cline; /* and set this one as current */
X
X /* process directives */
X if (*cline == '!') {
X /* save directive location and skip it */
X tmp = cline;
X while (*execstr && *execstr != ' ' && *execstr != '\t')
X ++execstr;
X
X if (tmp[1] == 'f' && tmp[2] == 'o') {
X force = TRUE;
X goto do001;
X
X } else if (tmp[1] == 'i' && tmp[2] == 'f') {
X
X /* IF directive */
X /* grab the value of the logical exp */
X if (execlevel == 0) {
X if ((status = macarg(token)) != TRUE) {
X execstr = oldestr;
X return(status);
X }
X status = stol(token);
X } else
X status = TRUE;
X
X if (status) {
X
X /* IF (TRUE) */
X if (execlevel != 0)
X ++execlevel;
X } else {
X
X /* IF (FALSE) */
X ++execlevel;
X }
X
X } else if (tmp[1] == 'e' && tmp[2] == 'l') {
X
X /* ELSE directive */
X if (execlevel == 1)
X --execlevel;
X else if (execlevel == 0 )
X ++execlevel;
X
X } else if (tmp[1] == 'e' && tmp[2] == 'n') {
X
X /* ENDIF directive */
X if (execlevel)
X --execlevel;
X
X } else if (tmp[1] == 'r' && tmp[2] == 'e') {
X
X /* RETURN directive */
X execstr = oldestr;
X if (execlevel)
X return(TRUE);
X else
X return(RET);
X
X } else if (tmp[1] == 'g' && tmp[2] == 'o') {
X
X /* GOTO directive */
X /* .....only if we are currently executing */
X if (execlevel) {
X execstr = oldestr;
X return(TRUE);
X }
X
X while (*execstr == ' ' || *execstr == '\t')
X ++execstr;
X strncpy(golabel, execstr, NPAT - 1);
X return(GOLINE);
X
X } else {
X mlwrite("%%Unknown Directive");
X return(FALSE);
X }
X
X /* restore execstr and exit */
X execstr = oldestr;
X return(TRUE);
X }
X
Xdo001: /* if we are scanning and not executing..go back here */
X if (execlevel) {
X execstr = oldestr;
X return(TRUE);
X }
X
X /* first set up the default command values */
X f = FALSE;
X n = 1;
X lastflag = thisflag;
X thisflag = 0;
X
X if ((status = macarg(token)) != TRUE) { /* and grab the first token */
X execstr = oldestr;
X return(status);
X }
X
X /* process leadin argument */
X if (gettyp(token) != TKCMD) {
X f = TRUE;
X strcpy(token, getval(token));
X n = atoi(token);
X
X /* and now get the command to execute */
X if ((status = macarg(token)) != TRUE) {
X execstr = oldestr;
X return(status);
X }
X }
X
X /* and match the token to see if it exists */
X if ((fnc = fncmatch(token)) == NULL) {
X mlwrite("[No such Function]");
X execstr = oldestr;
X return(FALSE);
X }
X
X /* save the arguments and go execute the command */
X oldcle = clexec; /* save old clexec flag */
X clexec = TRUE; /* in cline execution */
X status = (*fnc)(f, n); /* call the function */
X cmdstatus = status; /* save the status */
X if (force) /* force the status */
X status = TRUE;
X clexec = oldcle; /* restore clexec flag */
X execstr = oldestr;
X return(status);
X}
X
X/* token: chop a token off a string
X return a pointer past the token
X*/
X
Xchar *token(src, tok)
X
Xchar *src, *tok; /* source string, destination token string */
X
X{
X register int quotef; /* is the current string quoted? */
X
X /* first scan past any whitespace in the source string */
X while (*src == ' ' || *src == '\t')
X ++src;
X
X /* scan through the source string */
X quotef = FALSE;
X while (*src) {
X /* process special characters */
X if (*src == '~') {
X ++src;
X if (*src == 0)
X break;
X switch (*src++) {
X case 'r': *tok++ = 13; break;
X case 'n': *tok++ = 10; break;
X case 't': *tok++ = 9; break;
X case 'b': *tok++ = 8; break;
X case 'f': *tok++ = 12; break;
X default: *tok++ = *(src-1);
X }
X } else {
X /* check for the end of the token */
X if (quotef) {
X if (*src == '"')
X break;
X } else {
X if (*src == ' ' || *src == '\t')
X break;
X }
X
X /* set quote mode if qoute found */
X if (*src == '"')
X quotef = TRUE;
X
X /* record the character */
X *tok++ = *src++;
X }
X }
X
X /* terminate the token and exit */
X if (*src)
X ++src;
X *tok = 0;
X return(src);
X}
X
Xmacarg(tok) /* get a macro line argument */
X
Xchar *tok; /* buffer to place argument */
X
X{
X int savcle; /* buffer to store original clexec */
X int status;
X
X savcle = clexec; /* save execution mode */
X clexec = TRUE; /* get the argument */
X status = nextarg("", tok, NSTRING, ctoec('\n'));
X clexec = savcle; /* restore execution mode */
X return(status);
X}
X
X/* nextarg: get the next argument */
X
Xnextarg(prompt, buffer, size, terminator)
X
Xchar *prompt; /* prompt to use if we must be interactive */
Xchar *buffer; /* buffer to put token into */
Xchar *size; /* size of the buffer */
Xint terminator; /* terminating char to be used on interactive fetch */
X
X{
X /* if we are interactive, go get it! */
X if (clexec == FALSE)
X return(getstring(prompt, buffer, size, terminator));
X
X /* grab token and advance past */
X execstr = token(execstr, buffer);
X
X /* evaluate it */
X strcpy(buffer, getval(buffer));
X return(TRUE);
X}
X
X/* storemac: Set up a macro buffer and flag to store all
X executed command lines there */
X
Xstoremac(f, n)
X
Xint f; /* default flag */
Xint n; /* macro number to use */
X
X{
X register struct BUFFER *bp; /* pointer to macro buffer */
X char bname[NBUFN]; /* name of buffer to use */
X
X /* must have a numeric argument to this function */
X if (f == FALSE) {
X mlwrite("No macro specified");
X return(FALSE);
X }
X
X /* range check the macro number */
X if (n < 1 || n > 40) {
X mlwrite("Macro number out of range");
X return(FALSE);
X }
X
X /* construct the macro buffer name */
X strcpy(bname, "[Macro xx]");
X bname[7] = '0' + (n / 10);
X bname[8] = '0' + (n % 10);
X
X /* set up the new macro buffer */
X if ((bp = bfind(bname, TRUE, BFINVS)) == NULL) {
X mlwrite("Can not create macro");
X return(FALSE);
X }
X
X /* and make sure it is empty */
X bclear(bp);
X
X /* and set the macro store pointers to it */
X mstore = TRUE;
X bstore = bp;
X return(TRUE);
X}
X
X#if PROC
X/* storeproc: Set up a procedure buffer and flag to store all
X executed command lines there */
X
Xstoreproc(f, n)
X
Xint f; /* default flag */
Xint n; /* macro number to use */
X
X{
X register struct BUFFER *bp; /* pointer to macro buffer */
X register int status; /* return status */
X char bname[NBUFN]; /* name of buffer to use */
X
X /* a numeric argument means its a numbered macro */
X if (f == TRUE)
X return(storemac(f, n));
X
X /* get the name of the procedure */
X if ((status = mlreply("Procedure name: ", &bname[1], NBUFN-2)) != TRUE)
X return(status);
X
X /* construct the macro buffer name */
X bname[0] = '[';
X strcat(bname, "]");
X
X /* set up the new macro buffer */
X if ((bp = bfind(bname, TRUE, BFINVS)) == NULL) {
X mlwrite("Can not create macro");
X return(FALSE);
X }
X
X /* and make sure it is empty */
X bclear(bp);
X
X /* and set the macro store pointers to it */
X mstore = TRUE;
X bstore = bp;
X return(TRUE);
X}
X
X/* execproc: Execute a procedure */
X
Xexecproc(f, n)
X
Xint f, n; /* default flag and numeric arg */
X
X{
X register BUFFER *bp; /* ptr to buffer to execute */
X register int status; /* status return */
X char bufn[NBUFN+2]; /* name of buffer to execute */
X
X /* find out what buffer the user wants to execute */
X if ((status = mlreply("Execute procedure: ", &bufn[1], NBUFN)) != TRUE)
X return(status);
X
X /* construct the buffer name */
X bufn[0] = '[';
X strcat(bufn, "]");
X
X /* find the pointer to that buffer */
X if ((bp=bfind(bufn, FALSE, 0)) == NULL) {
X mlwrite("No such procedure");
X return(FALSE);
X }
X
X /* and now execute it as asked */
X while (n-- > 0)
X if ((status = dobuf(bp)) != TRUE)
X return(status);
X return(TRUE);
X}
X#endif
X
X/* execbuf: Execute the contents of a buffer of commands */
X
Xexecbuf(f, n)
X
Xint f, n; /* default flag and numeric arg */
X
X{
X register BUFFER *bp; /* ptr to buffer to execute */
X register int status; /* status return */
X char bufn[NBUFN]; /* name of buffer to execute */
X
X /* find out what buffer the user wants to execute */
X if ((status = mlreply("Execute buffer: ", bufn, NBUFN)) != TRUE)
X return(status);
X
X /* find the pointer to that buffer */
X if ((bp=bfind(bufn, FALSE, 0)) == NULL) {
X mlwrite("No such buffer");
X return(FALSE);
X }
X
X /* and now execute it as asked */
X while (n-- > 0)
X if ((status = dobuf(bp)) != TRUE)
X return(status);
X return(TRUE);
X}
X
X/* dobuf: execute the contents of the buffer pointed to
X by the passed BP */
X
Xdobuf(bp)
X
XBUFFER *bp; /* buffer to execute */
X
X{
X register int status; /* status return */
X register LINE *lp; /* pointer to line to execute */
X register LINE *hlp; /* pointer to line header */
X register LINE *glp; /* line to goto */
X register int linlen; /* length of line to execute */
X register WINDOW *wp; /* ptr to windows to scan */
X char *eline; /* text of line to execute */
X
X /* clear IF level flags */
X execlevel = 0;
X
X /* starting at the beginning of the buffer */
X hlp = bp->b_linep;
X lp = hlp->l_fp;
X while (lp != hlp) {
X /* allocate eline and copy macro line to it */
X linlen = lp->l_used;
X if ((eline = malloc(linlen+1)) == NULL) {
X mlwrite("%%Out of Memory during macro execution");
X return(FALSE);
X }
X strncpy(eline, lp->l_text, linlen);
X eline[linlen] = 0; /* make sure it ends */
X
X /* trim leading whitespace */
X while (eline[0] == ' ' || eline[0] == '\t')
X strcpy(eline, &eline[1]);
X
X /* if it is not a comment, execute it */
X if (eline[0] != 0 && eline[0] != ';') {
X status = docmd(eline);
X
X /* if it is a !GOTO directive, deal with it */
X if (status == GOLINE) {
X linlen = strlen(golabel);
X glp = hlp->l_fp;
X while (glp != hlp) {
X if (*glp->l_text == '*' &&
X (strncmp(&glp->l_text[1], golabel,
X linlen) == 0)) {
X lp = glp;
X status = TRUE;
X }
X glp = glp->l_fp;
X }
X }
X
X if (status == GOLINE) {
X mlwrite("%%No such label");
X return(FALSE);
X }
X
X /* if it is a !RETURN directive...do so */
X if (status == RET) {
X free(eline);
X break;
X }
X
X /* check for a command error */
X if (status != TRUE) {
X /* look if buffer is showing */
X wp = wheadp;
X while (wp != NULL) {
X if (wp->w_bufp == bp) {
X /* and point it */
X wp->w_dotp = lp;
X wp->w_doto = 0;
X wp->w_flag |= WFHARD;
X }
X wp = wp->w_wndp;
X }
X /* in any case set the buffer . */
X bp->b_dotp = lp;
X bp->b_doto = 0;
X free(eline);
X execlevel = 0;
X return(status);
X }
X }
X
X /* on to the next line */
X free(eline);
X lp = lp->l_fp;
X }
X
X /* exit the current function */
X execlevel = 0;
X return(TRUE);
X}
X
Xexecfile(f, n) /* execute a series of commands in a file
X*/
X
Xint f, n; /* default flag and numeric arg to pass on to file */
X
X{
X register int status; /* return status of name query */
X char fname[NSTRING]; /* name of file to execute */
X
X if ((status = mlreply("File to execute: ", fname, NSTRING -1)) != TRUE)
X return(status);
X
X /* otherwise, execute it */
X while (n-- > 0)
X if ((status=dofile(fname)) != TRUE)
X return(status);
X
X return(TRUE);
X}
X
X/* dofile: yank a file into a buffer and execute it
X if there are no errors, delete the buffer on exit */
X
Xdofile(fname)
X
Xchar *fname; /* file name to execute */
X
X{
X register BUFFER *bp; /* buffer to place file to exeute */
X register BUFFER *cb; /* temp to hold current buf while we read */
X register int status; /* results of various calls */
X char bname[NBUFN]; /* name of buffer */
X
X makename(bname, fname); /* derive the name of the buffer */
X if ((bp = bfind(bname, TRUE, 0)) == NULL) /* get the needed buffer */
X return(FALSE);
X
X bp->b_mode = MDVIEW; /* mark the buffer as read only */
X cb = curbp; /* save the old buffer */
X curbp = bp; /* make this one current */
X /* and try to read in the file to execute */
X if ((status = readin(fname, FALSE)) != TRUE) {
X curbp = cb; /* restore the current buffer */
X return(status);
X }
X
X /* go execute it! */
X curbp = cb; /* restore the current buffer */
X if ((status = dobuf(bp)) != TRUE)
X return(status);
X
X /* if not displayed, remove the now unneeded buffer and exit */
X if (bp->b_nwnd == 0)
X zotbuf(bp);
X return(TRUE);
X}
X
X/* cbuf: Execute the contents of a numbered buffer */
X
Xcbuf(f, n, bufnum)
X
Xint f, n; /* default flag and numeric arg */
Xint bufnum; /* number of buffer to execute */
X
X{
X register BUFFER *bp; /* ptr to buffer to execute */
X register int status; /* status return */
X static char bufname[] = "[Macro xx]";
X
X /* make the buffer name */
X bufname[7] = '0' + (bufnum / 10);
X bufname[8] = '0' + (bufnum % 10);
X
X /* find the pointer to that buffer */
X if ((bp=bfind(bufname, FALSE, 0)) == NULL) {
X mlwrite("Macro not defined");
X return(FALSE);
X }
X
X /* and now execute it as asked */
X while (n-- > 0)
X if ((status = dobuf(bp)) != TRUE)
X return(status);
X return(TRUE);
X}
X
Xcbuf1(f, n)
X
X{
X cbuf(f, n, 1);
X}
X
Xcbuf2(f, n)
X
X{
X cbuf(f, n, 2);
X}
X
Xcbuf3(f, n)
X
X{
X cbuf(f, n, 3);
X}
X
Xcbuf4(f, n)
X
X{
X cbuf(f, n, 4);
X}
X
Xcbuf5(f, n)
X
X{
X cbuf(f, n, 5);
X}
X
Xcbuf6(f, n)
X
X{
X cbuf(f, n, 6);
X}
X
Xcbuf7(f, n)
X
X{
X cbuf(f, n, 7);
X}
X
Xcbuf8(f, n)
X
X{
X cbuf(f, n, 8);
X}
X
Xcbuf9(f, n)
X
X{
X cbuf(f, n, 9);
X}
X
Xcbuf10(f, n)
X
X{
X cbuf(f, n, 10);
X}
X
Xcbuf11(f, n)
X
X{
X cbuf(f, n, 11);
X}
X
Xcbuf12(f, n)
X
X{
X cbuf(f, n, 12);
X}
X
Xcbuf13(f, n)
X
X{
X cbuf(f, n, 13);
X}
X
Xcbuf14(f, n)
X
X{
X cbuf(f, n, 14);
X}
X
Xcbuf15(f, n)
X
X{
X cbuf(f, n, 15);
X}
X
Xcbuf16(f, n)
X
X{
X cbuf(f, n, 16);
X}
X
Xcbuf17(f, n)
X
X{
X cbuf(f, n, 17);
X}
X
Xcbuf18(f, n)
X
X{
X cbuf(f, n, 18);
X}
X
Xcbuf19(f, n)
X
X{
X cbuf(f, n, 19);
X}
X
Xcbuf20(f, n)
X
X{
X cbuf(f, n, 20);
X}
X
Xcbuf21(f, n)
X
X{
X cbuf(f, n, 21);
X}
X
Xcbuf22(f, n)
X
X{
X cbuf(f, n, 22);
X}
X
Xcbuf23(f, n)
X
X{
X cbuf(f, n, 23);
X}
X
Xcbuf24(f, n)
X
X{
X cbuf(f, n, 24);
X}
X
Xcbuf25(f, n)
X
X{
X cbuf(f, n, 25);
X}
X
Xcbuf26(f, n)
X
X{
X cbuf(f, n, 26);
X}
X
Xcbuf27(f, n)
X
X{
X cbuf(f, n, 27);
X}
X
Xcbuf28(f, n)
X
X{
X cbuf(f, n, 28);
X}
X
Xcbuf29(f, n)
X
X{
X cbuf(f, n, 29);
X}
X
Xcbuf30(f, n)
X
X{
X cbuf(f, n, 30);
X}
X
Xcbuf31(f, n)
X
X{
X cbuf(f, n, 31);
X}
X
Xcbuf32(f, n)
X
X{
X cbuf(f, n, 32);
X}
X
Xcbuf33(f, n)
X
X{
X cbuf(f, n, 33);
X}
X
Xcbuf34(f, n)
X
X{
X cbuf(f, n, 34);
X}
X
Xcbuf35(f, n)
X
X{
X cbuf(f, n, 35);
X}
X
Xcbuf36(f, n)
X
X{
X cbuf(f, n, 36);
X}
X
Xcbuf37(f, n)
X
X{
X cbuf(f, n, 37);
X}
X
Xcbuf38(f, n)
X
X{
X cbuf(f, n, 38);
X}
X
Xcbuf39(f, n)
X
X{
X cbuf(f, n, 39);
X}
X
Xcbuf40(f, n)
X
X{
X cbuf(f, n, 40);
X}
X
X
E!O!F
newsize=`wc -c < exec.c`
if [ $newsize -ne 18271 ]
then echo "File exec.c was $newsize bytes, 18271 expected"
fi
echo 'x - file.c (text)'
sed << 'E!O!F' 's/^X//' > file.c
X/* FILE.C: for MicroEMACS
X
X The routines in this file handle the reading, writing
X and lookup of disk files. All of details about the
X reading and writing of the disk are in "fileio.c".
X
X*/
X
X#include <stdio.h>
X#include "estruct.h"
X#include "edef.h"
X
X/*
X * Read a file into the current
X * buffer. This is really easy; all you do it
X * find the name of the file, and call the standard
X * "read a file into the current buffer" code.
X * Bound to "C-X C-R".
X */
Xfileread(f, n)
X{
X register int s;
X char fname[NFILEN];
X
X if (restflag) /* don't allow this command if restricted */
X return(resterr());
X if ((s=mlreply("Read file: ", fname, NFILEN)) != TRUE)
X return(s);
X return(readin(fname, TRUE));
X}
X
X/*
X * Insert a file into the current
X * buffer. This is really easy; all you do it
X * find the name of the file, and call the standard
X * "insert a file into the current buffer" code.
X * Bound to "C-X C-I".
X */
Xinsfile(f, n)
X{
X register int s;
X char fname[NFILEN];
X
X if (restflag) /* don't allow this command if restricted */
X return(resterr());
X if (curbp->b_mode&MDVIEW) /* don't allow this command if */
X return(rdonly()); /* we are in read only mode */
X if ((s=mlreply("Insert file: ", fname, NFILEN)) != TRUE)
X return(s);
X return(ifile(fname));
X}
X
X/*
X * Select a file for editing.
X * Look around to see if you can find the
X * fine in another buffer; if you can find it
X * just switch to the buffer. If you cannot find
X * the file, create a new buffer, read in the
X * text, and switch to the new buffer.
X * Bound to C-X C-F.
X */
Xfilefind(f, n)
X{
X char fname[NFILEN]; /* file user wishes to find */
X register int s; /* status return */
X
X if (restflag) /* don't allow this command if restricted */
X return(resterr());
X if ((s=mlreply("Find file: ", fname, NFILEN)) != TRUE)
X return(s);
X return(getfile(fname, TRUE));
X}
X
Xviewfile(f, n) /* visit a file in VIEW mode */
X{
X char fname[NFILEN]; /* file user wishes to find */
X register int s; /* status return */
X register WINDOW *wp; /* scan for windows that need updating */
X
X if (restflag) /* don't allow this command if restricted */
X return(resterr());
X if ((s=mlreply("View file: ", fname, NFILEN)) != TRUE)
X return (s);
X s = getfile(fname, FALSE);
X if (s) { /* if we succeed, put it in view mode */
X curwp->w_bufp->b_mode |= MDVIEW;
X
X /* scan through and update mode lines of all windows */
X wp = wheadp;
X while (wp != NULL) {
X wp->w_flag |= WFMODE;
X wp = wp->w_wndp;
X }
X }
X return(s);
X}
X
X#if CRYPT
Xresetkey() /* reset the encryption key if needed */
X
X{
X register int s; /* return status */
X
X /* turn off the encryption flag */
X cryptflag = FALSE;
X
X /* if we are in crypt mode */
X if (curbp->b_mode & MDCRYPT) {
X if (curbp->b_key[0] == 0) {
X s = setkey(FALSE, 0);
X if (s != TRUE)
X return(s);
X }
X
X /* let others know... */
X cryptflag = TRUE;
X
X /* and set up the key to be used! */
X /* de-encrypt it */
X crypt((char *)NULL, 0);
X crypt(curbp->b_key, strlen(curbp->b_key));
X
X /* re-encrypt it...seeding it to start */
X crypt((char *)NULL, 0);
X crypt(curbp->b_key, strlen(curbp->b_key));
X }
X
X return(TRUE);
X}
X#endif
X
Xgetfile(fname, lockfl)
X
Xchar fname[]; /* file name to find */
Xint lockfl; /* check the file for locks? */
X
X{
X register BUFFER *bp;
X register LINE *lp;
X register int i;
X register int s;
X char bname[NBUFN]; /* buffer name to put file */
X
X#if MSDOS
X mklower(fname); /* msdos isn't case sensitive */
X#endif
X for (bp=bheadp; bp!=NULL; bp=bp->b_bufp) {
X if ((bp->b_flag&BFINVS)==0 && strcmp(bp->b_fname, fname)==0) {
X swbuffer(bp);
X lp = curwp->w_dotp;
X i = curwp->w_ntrows/2;
X while (i-- && lback(lp)!=curbp->b_linep)
X lp = lback(lp);
X curwp->w_linep = lp;
X curwp->w_flag |= WFMODE|WFHARD;
X mlwrite("[Old buffer]");
X return (TRUE);
X }
X }
X makename(bname, fname); /* New buffer name. */
X while ((bp=bfind(bname, FALSE, 0)) != NULL) {
X /* old buffer name conflict code */
X s = mlreply("Buffer name: ", bname, NBUFN);
X if (s == ABORT) /* ^G to just quit */
X return (s);
X if (s == FALSE) { /* CR to clobber it */
X makename(bname, fname);
X break;
X }
X }
X if (bp==NULL && (bp=bfind(bname, TRUE, 0))==NULL) {
X mlwrite("Cannot create buffer");
X return (FALSE);
X }
X if (--curbp->b_nwnd == 0) { /* Undisplay. */
X curbp->b_dotp = curwp->w_dotp;
X curbp->b_doto = curwp->w_doto;
X curbp->b_markp = curwp->w_markp;
X curbp->b_marko = curwp->w_marko;
X }
X curbp = bp; /* Switch to it. */
X curwp->w_bufp = bp;
X curbp->b_nwnd++;
X return(readin(fname, lockfl)); /* Read it in. */
X}
X
X/*
X * Read file "fname" into the current
X * buffer, blowing away any text found there. Called
X * by both the read and find commands. Return the final
X * status of the read. Also called by the mainline,
X * to read in a file specified on the command line as
X * an argument. If the filename ends in a ".c", CMODE is
X * set for the current buffer.
X */
Xreadin(fname, lockfl)
X
Xchar fname[]; /* name of file to read */
Xint lockfl; /* check for file locks? */
X
X{
X register LINE *lp1;
X register LINE *lp2;
X register int i;
X register WINDOW *wp;
X register BUFFER *bp;
X register int s;
X register int nbytes;
X register int nline;
X register char *sptr; /* pointer into filename string */
X int lflag; /* any lines longer than allowed? */
X char line[NLINE];
X
X#if FILOCK
X if (lockfl && lockchk(fname) == ABORT)
X return(ABORT);
X#endif
X#if CRYPT
X s = resetkey();
X if (s != TRUE)
X return(s);
X#endif
X bp = curbp; /* Cheap. */
X if ((s=bclear(bp)) != TRUE) /* Might be old. */
X return (s);
X bp->b_flag &= ~(BFINVS|BFCHG);
X#if ACMODE
X if (strlen(fname) > 1) { /* check if a 'C' file */
X sptr = fname + strlen(fname) - 2;
X if (*sptr == '.' &&
X (*(sptr + 1) == 'c' || *(sptr + 1) == 'h'))
X bp->b_mode |= MDCMOD;
X }
X#endif
X strcpy(bp->b_fname, fname);
X
X /* turn off ALL keyboard translation in case we get a dos error */
X TTkclose();
X
X if ((s=ffropen(fname)) == FIOERR) /* Hard file open. */
X goto out;
X if (s == FIOFNF) { /* File not found. */
X mlwrite("[New file]");
X goto out;
X }
X mlwrite("[Reading file]");
X nline = 0;
X lflag = FALSE;
X while ((s=ffgetline(line, NLINE)) == FIOSUC || s == FIOLNG
X || s == FIOFUN) {
X if (s == FIOLNG) {
X lflag = TRUE;
X --nline;
X }
X nbytes = strlen(line);
X if ((lp1=lalloc(nbytes)) == NULL) {
X s = FIOERR; /* Keep message on the */
X break; /* display. */
X }
X lp2 = lback(curbp->b_linep);
X lp2->l_fp = lp1;
X lp1->l_fp = curbp->b_linep;
X lp1->l_bp = lp2;
X curbp->b_linep->l_bp = lp1;
X for (i=0; i<nbytes; ++i)
X lputc(lp1, i, line[i]);
X ++nline;
X if (s == FIOFUN)
X break;
X }
X ffclose(); /* Ignore errors. */
X strcpy(line, "[");
X if (lflag)
X strcat(line, "Long lines wrapped, ");
X if (s == FIOFUN)
X strcat(line, "Funny line at EOF, ");
X if (s == FIOEOF || s == FIOFUN) { /* Don't zap message! */
X sprintf(&line[strlen(line)], "Read %d line", nline);
X if (nline > 1)
X strcat(line, "s");
X strcat(line, "]");
X }
X if (s != FIOERR)
X mlwrite(line);
X
Xout:
X TTkopen(); /* open the keyboard again */
X for (wp=wheadp; wp!=NULL; wp=wp->w_wndp) {
X if (wp->w_bufp == curbp) {
X wp->w_linep = lforw(curbp->b_linep);
X wp->w_dotp = lforw(curbp->b_linep);
X wp->w_doto = 0;
X wp->w_markp = NULL;
X wp->w_marko = 0;
X wp->w_flag |= WFMODE|WFHARD;
X }
X }
X if (s == FIOERR || s == FIOFNF) /* False if error. */
X return(FALSE);
X return (TRUE);
X}
X
X/*
X * Take a file name, and from it
X * fabricate a buffer name. This routine knows
X * about the syntax of file names on the target system.
X * I suppose that this information could be put in
X * a better place than a line of code.
X */
Xmakename(bname, fname)
Xchar bname[];
Xchar fname[];
X{
X register char *cp1;
X register char *cp2;
X
X cp1 = &fname[0];
X while (*cp1 != 0)
X ++cp1;
X
X#if AMIGA
X while (cp1!=&fname[0] && cp1[-1]!=':' && cp1[-1]!='/')
X --cp1;
X#endif
X#if VMS
X while (cp1!=&fname[0] && cp1[-1]!=':' && cp1[-1]!=']')
X --cp1;
X#endif
X#if CPM
X while (cp1!=&fname[0] && cp1[-1]!=':')
X --cp1;
X#endif
X#if MSDOS
X while (cp1!=&fname[0] && cp1[-1]!=':' && cp1[-1]!='\\'&&cp1[-1]!='/')
X --cp1;
X#endif
X#if ST520
X while (cp1!=&fname[0] && cp1[-1]!=':' && cp1[-1]!='\\')
X --cp1;
X#endif
X#if FINDER
X while (cp1!=&fname[0] && cp1[-1]!=':' && cp1[-1]!='\\'&&cp1[-1]!='/')
X --cp1;
X#endif
X#if V7 | USG | BSD
X while (cp1!=&fname[0] && cp1[-1]!='/')
X --cp1;
X#endif
X cp2 = &bname[0];
X while (cp2!=&bname[NBUFN-1] && *cp1!=0 && *cp1!=';')
X *cp2++ = *cp1++;
X *cp2 = 0;
X}
X
Xunqname(name) /* make sure a buffer name is unique */
X
Xchar *name; /* name to check on */
X
X{
X register char *sp;
X
X /* check to see if it is in the buffer list */
X while (bfind(name, 0, FALSE) != NULL) {
X
X /* go to the end of the name */
X sp = name;
X while (*sp)
X ++sp;
X if (sp == name || (*(sp-1) <'0' || *(sp-1) > '8')) {
X *sp++ = '0';
X *sp = 0;
X } else
X *(--sp) += 1;
X }
X}
X
X/*
X * Ask for a file name, and write the
X * contents of the current buffer to that file.
X * Update the remembered file name and clear the
X * buffer changed flag. This handling of file names
X * is different from the earlier versions, and
X * is more compatable with Gosling EMACS than
X * with ITS EMACS. Bound to "C-X C-W".
X */
Xfilewrite(f, n)
X{
X register WINDOW *wp;
X register int s;
X char fname[NFILEN];
X
X if (restflag) /* don't allow this command if restricted */
X return(resterr());
X if ((s=mlreply("Write file: ", fname, NFILEN)) != TRUE)
X return (s);
X if ((s=writeout(fname)) == TRUE) {
X strcpy(curbp->b_fname, fname);
X curbp->b_flag &= ~BFCHG;
X wp = wheadp; /* Update mode lines. */
X while (wp != NULL) {
X if (wp->w_bufp == curbp)
X wp->w_flag |= WFMODE;
X wp = wp->w_wndp;
X }
X }
X return (s);
X}
X
X/*
X * Save the contents of the current
X * buffer in its associatd file. No nothing
X * if nothing has changed (this may be a bug, not a
X * feature). Error if there is no remembered file
X * name for the buffer. Bound to "C-X C-S". May
X * get called by "C-Z".
X */
Xfilesave(f, n)
X{
X register WINDOW *wp;
X register int s;
X
X if (curbp->b_mode&MDVIEW) /* don't allow this command if */
X return(rdonly()); /* we are in read only mode */
X if ((curbp->b_flag&BFCHG) == 0) /* Return, no changes. */
X return (TRUE);
X if (curbp->b_fname[0] == 0) { /* Must have a name. */
X mlwrite("No file name");
X return (FALSE);
X }
X if ((s=writeout(curbp->b_fname)) == TRUE) {
X curbp->b_flag &= ~BFCHG;
X wp = wheadp; /* Update mode lines. */
X while (wp != NULL) {
X if (wp->w_bufp == curbp)
X wp->w_flag |= WFMODE;
X wp = wp->w_wndp;
X }
X }
X return (s);
X}
X
X/*
X * This function performs the details of file
X * writing. Uses the file management routines in the
X * "fileio.c" package. The number of lines written is
X * displayed. Sadly, it looks inside a LINE; provide
X * a macro for this. Most of the grief is error
X * checking of some sort.
X */
Xwriteout(fn)
Xchar *fn;
X{
X register int s;
X register LINE *lp;
X register int nline;
X
X#if CRYPT
X s = resetkey();
X if (s != TRUE)
X return(s);
X#endif
X /* turn off ALL keyboard translation in case we get a dos error */
X TTkclose();
X
X if ((s=ffwopen(fn)) != FIOSUC) { /* Open writes message. */
X TTkopen();
X return (FALSE);
X }
X mlwrite("[Writing..]"); /* tell us were writing */
X lp = lforw(curbp->b_linep); /* First line. */
X nline = 0; /* Number of lines. */
X while (lp != curbp->b_linep) {
X if ((s=ffputline(&lp->l_text[0], llength(lp))) != FIOSUC)
X break;
X ++nline;
X lp = lforw(lp);
X }
X if (s == FIOSUC) { /* No write error. */
X s = ffclose();
X if (s == FIOSUC) { /* No close error. */
X if (nline == 1)
X mlwrite("[Wrote 1 line]");
X else
X mlwrite("[Wrote %d lines]", nline);
X }
X } else /* Ignore close error */
X ffclose(); /* if a write error. */
X TTkopen();
X if (s != FIOSUC) /* Some sort of error. */
X return (FALSE);
X return (TRUE);
X}
X
X/*
X * The command allows the user
X * to modify the file name associated with
X * the current buffer. It is like the "f" command
X * in UNIX "ed". The operation is simple; just zap
X * the name in the BUFFER structure, and mark the windows
X * as needing an update. You can type a blank line at the
X * prompt if you wish.
X */
Xfilename(f, n)
X{
X register WINDOW *wp;
X register int s;
X char fname[NFILEN];
X
X if (restflag) /* don't allow this command if restricted */
X return(resterr());
X if ((s=mlreply("Name: ", fname, NFILEN)) == ABORT)
X return (s);
X if (s == FALSE)
X strcpy(curbp->b_fname, "");
X else
X strcpy(curbp->b_fname, fname);
X wp = wheadp; /* Update mode lines. */
X while (wp != NULL) {
X if (wp->w_bufp == curbp)
X wp->w_flag |= WFMODE;
X wp = wp->w_wndp;
X }
X curbp->b_mode &= ~MDVIEW; /* no longer read only mode */
X return (TRUE);
X}
X
X/*
X * Insert file "fname" into the current
X * buffer, Called by insert file command. Return the final
X * status of the read.
X */
Xifile(fname)
Xchar fname[];
X{
X register LINE *lp0;
X register LINE *lp1;
X register LINE *lp2;
X register int i;
X register BUFFER *bp;
X register int s;
X register int nbytes;
X register int nline;
X int lflag; /* any lines longer than allowed? */
X char line[NLINE];
X
X bp = curbp; /* Cheap. */
X bp->b_flag |= BFCHG; /* we have changed */
X bp->b_flag &= ~BFINVS; /* and are not temporary*/
X if ((s=ffropen(fname)) == FIOERR) /* Hard file open. */
X goto out;
X if (s == FIOFNF) { /* File not found. */
X mlwrite("[No such file]");
X return(FALSE);
X }
X mlwrite("[Inserting file]");
X
X#if CRYPT
X s = resetkey();
X if (s != TRUE)
X return(s);
X#endif
X /* back up a line and save the mark here */
X curwp->w_dotp = lback(curwp->w_dotp);
X curwp->w_doto = 0;
X curwp->w_markp = curwp->w_dotp;
X curwp->w_marko = 0;
X
X nline = 0;
X lflag = FALSE;
X while ((s=ffgetline(line, NLINE)) == FIOSUC || s == FIOLNG
X || s == FIOFUN) {
X if (s == FIOLNG) {
X lflag = TRUE;
X --nline;
X }
X nbytes = strlen(line);
X if ((lp1=lalloc(nbytes)) == NULL) {
X s = FIOERR; /* Keep message on the */
X break; /* display. */
X }
X lp0 = curwp->w_dotp; /* line previous to insert */
X lp2 = lp0->l_fp; /* line after insert */
X
X /* re-link new line between lp0 and lp2 */
X lp2->l_bp = lp1;
X lp0->l_fp = lp1;
X lp1->l_bp = lp0;
X lp1->l_fp = lp2;
X
X /* and advance and write out the current line */
X curwp->w_dotp = lp1;
X for (i=0; i<nbytes; ++i)
X lputc(lp1, i, line[i]);
X ++nline;
X if (s == FIOFUN)
X break;
X }
X ffclose(); /* Ignore errors. */
X curwp->w_markp = lforw(curwp->w_markp);
X strcpy(line, "[");
X if (lflag)
X strcat(line, "Long lines wrapped, ");
X if (s == FIOFUN)
X strcat(line, "Funny line at EOF, ");
X if (s == FIOEOF || s == FIOFUN) { /* Don't zap message! */
X sprintf(&line[strlen(line)], "Inserted %d line", nline);
X if (nline > 1)
X strcat(line, "s");
X strcat(line, "]");
X }
X if (s != FIOERR)
X mlwrite(line);
Xout:
X /* advance to the next line and mark the window for changes */
X curwp->w_dotp = lforw(curwp->w_dotp);
X curwp->w_flag |= WFHARD | WFMODE;
X
X /* copy window parameters back to the buffer structure */
X curbp->b_dotp = curwp->w_dotp;
X curbp->b_doto = curwp->w_doto;
X curbp->b_markp = curwp->w_markp;
X curbp->b_marko = curwp->w_marko;
X
X if (s == FIOERR) /* False if error. */
X return (FALSE);
X return (TRUE);
X}
E!O!F
newsize=`wc -c < file.c`
if [ $newsize -ne 18793 ]
then echo "File file.c was $newsize bytes, 18793 expected"
fi
echo 'x - fileio.c (text)'
sed << 'E!O!F' 's/^X//' > fileio.c
X/*
X * The routines in this file read and write ASCII files from the disk. All of
X * the knowledge about files are here. A better message writing scheme should
X * be used.
X */
X#include <stdio.h>
X#include "estruct.h"
X#include "edef.h"
X
XFILE *ffp; /* File pointer, all functions. */
X
X/*
X * Open a file for reading.
X */
Xffropen(fn)
Xchar *fn;
X{
X if ((ffp=fopen(fn, "r")) == NULL)
X return (FIOFNF);
X return (FIOSUC);
X}
X
X/*
X * Open a file for writing. Return TRUE if all is well, and FALSE on error
X * (cannot create).
X */
Xffwopen(fn)
Xchar *fn;
X{
X#if VMS
X register int fd;
X
X if ((fd=creat(fn, 0666, "rfm=var", "rat=cr")) < 0
X || (ffp=fdopen(fd, "w")) == NULL) {
X#else
X if ((ffp=fopen(fn, "w")) == NULL) {
X#endif
X mlwrite("Cannot open file for writing");
X return (FIOERR);
X }
X return (FIOSUC);
X}
X
X/*
X * Close a file. Should look at the status in all systems.
X */
Xffclose()
X{
X#if MSDOS & CTRLZ
X fputc(26, ffp); /* add a ^Z at the end of the file */
X#endif
X
X#if V7 | USG | BSD | (MSDOS & (LATTICE | MSC))
X if (fclose(ffp) != FALSE) {
X mlwrite("Error closing file");
X return(FIOERR);
X }
X return(FIOSUC);
X#else
X fclose(ffp);
X return (FIOSUC);
X#endif
X}
X
X/*
X * Write a line to the already opened file. The "buf" points to the buffer,
X * and the "nbuf" is its length, less the free newline. Return the status.
X * Check only at the newline.
X */
Xffputline(buf, nbuf)
Xchar buf[];
X{
X register int i;
X#if CRYPT
X char c; /* character to translate */
X
X if (cryptflag) {
X for (i = 0; i < nbuf; ++i) {
X c = buf[i] & 0xff;
X crypt(&c, 1);
X fputc(c, ffp);
X }
X } else
X for (i = 0; i < nbuf; ++i)
X fputc(buf[i]&0xFF, ffp);
X#else
X for (i = 0; i < nbuf; ++i)
X fputc(buf[i]&0xFF, ffp);
X#endif
X
X#if ST520
X fputc('\r', ffp);
X#endif
X fputc('\n', ffp);
X
X if (ferror(ffp)) {
X mlwrite("Write I/O error");
X return (FIOERR);
X }
X
X return (FIOSUC);
X}
X
X/*
X * Read a line from a file, and store the bytes in the supplied buffer. The
X * "nbuf" is the length of the buffer. Complain about long lines and lines
X * at the end of the file that don't have a newline present. Check for I/O
X * errors too. Return status.
X */
Xffgetline(buf, nbuf)
Xregister char buf[];
X{
X register int c;
X register int i;
X
X i = 0;
X
X while ((c = fgetc(ffp)) != EOF && c != '\n') {
X if (i >= nbuf-2) {
X buf[nbuf - 2] = c; /* store last char read */
X buf[nbuf - 1] = 0; /* and terminate it */
X mlwrite("File has long line");
X#if CRYPT
X if (cryptflag)
X crypt(buf, strlen(buf));
X#endif
X return (FIOLNG);
X }
X buf[i++] = c;
X }
X
X#if ST520
X if(buf[i-1] == '\r')
X i--;
X#endif
X if (c == EOF) {
X if (ferror(ffp)) {
X mlwrite("File read error");
X return (FIOERR);
X }
X
X if (i != 0) {
X buf[i] = 0;
X return(FIOFUN);
X }
X
X return (FIOEOF);
X }
X
X buf[i] = 0;
X#if CRYPT
X if (cryptflag)
X crypt(buf, strlen(buf));
X#endif
X return (FIOSUC);
X}
X
X#if AZTEC & MSDOS
X#undef fgetc
X/* a1getc: Get an ascii char from the file input stream
X but DO NOT strip the high bit
X*/
X
Xint a1getc(fp)
X
XFILE *fp;
X
X{
X int c; /* translated character */
X
X c = getc(fp); /* get the character */
X
X /* if its a <LF> char, throw it out */
X while (c == 10)
X c = getc(fp);
X
X /* if its a <RETURN> char, change it to a LF */
X if (c == '\r')
X c = '\n';
X
X /* if its a ^Z, its an EOF */
X if (c == 26)
X c = EOF;
X
X return(c);
X}
X#endif
E!O!F
newsize=`wc -c < fileio.c`
if [ $newsize -ne 3918 ]
then echo "File fileio.c was $newsize bytes, 3918 expected"
fi
echo 'x - files (text)'
sed << 'E!O!F' 's/^X//' > files
XANSI.C
XBASIC.C
XBIND.C
XBUFFER.C
XCRYPT.C
XDG10.C
XDISPLAY.C
XDOLOCK.C
XEBIND.H
XEDEF.H
XEFUNC.H
XEMACS.HLP
XEPATH.H
XESTRUCT.H
XEVAL.C
XEVAR.H
XEXEC.C
XFILE.C
XFILEIO.C
XHP110.C
XHP150.C
XIBMPC.C
XINPUT.C
XISEARCH.C
XLINE.C
XLOCK.C
XMAIN.C
XMAKEFILE
XRANDOM.C
XREGION.C
XSEARCH.C
XSPAWN.C
XST520.C
XTCAP.C
XTERMIO.C
XTIPC.C
XVMSVT.C
XVT52.C
XWINDOW.C
XWORD.C
XZ309.C
E!O!F
newsize=`wc -c < files`
if [ $newsize -ne 329 ]
then echo "File files was $newsize bytes, 329 expected"
fi
bill davidsen (wedu@ge-crd.arpa)
{chinet | philabs | sesimo}!steinmetz!crdos1!davidsen
"Stupidity, like virtue, is its own reward" -me
