Relay-Version: version B 2.10 5/3/83; site utzoo.UUCP
Path: utzoo!mnetor!uunet!husc6!cmcl2!rutgers!ames!necntc!ncoast!allbery
From: nwd@j.cc.purdue.edu (Daniel Lawrence)
Newsgroups: comp.sources.misc
Subject: MicroEmacs 3.9 (Part 4 of 16)
Message-ID: <5651@ncoast.UUCP>
Date: Sat, 14-Nov-87 16:07:57 EST
Article-I.D.: ncoast.5651
Posted: Sat Nov 14 16:07:57 1987
Date-Received: Tue, 17-Nov-87 03:01:54 EST
Sender: allbery@ncoast.UUCP
Lines: 1075
Approved: allbery@ncoast.UUCP
X-Archive: comp.sources.misc/microemacs-3.9/3


# This is a shar archive.
# Remove everything above this line.
# Run the file through sh, not csh.
# (type `sh mes.4')
# If you do not see the message
#	`mes.4 completed!'
# then the file was incomplete.
echo extracting - dolock.c
sed 's/^X//' > dolock.c << 'FRIDAY_NIGHT'
X#if	0
X/*	dolock:	MDBS specific Unix 4.2BSD file locking mechinism
X		this is not to be distributed generally		*/
X
X#include	<mdbs.h>
X#include	<mdbsio.h>
X#include	<sys/types.h>
X#include	<sys/stat.h>
X
X/* included by port.h: mdbs.h, mdbsio.h, sys/types.h, sys/stat.h */
X
X
X#ifndef bsdunix
Xchar *dolock(){return(NULL);}
Xchar *undolock(){return(NULL);}
X#else
X
X#include <pwd.h>
X#include <errno.h>
X
Xextern int errno;
X
X#define LOCKDIR ".xlk"
X
X#define LOCKMSG "LOCK ERROR -- "
X#define LOCKMSZ sizeof(LOCKMSG)
X#define LOCKERR(s) { strcat(lmsg,s); oldumask = umask(oldumask); return(lmsg); }
X
X/**********************
X *
X * dolock -- lock the file fname
X *
X * if successful, returns NULL 
X * if file locked, returns username of person locking the file
X * if other error, returns "LOCK ERROR: explanation"
X *
X * Jon Reid, 2/19/86
X *
X *********************/
X
XBOOL parent = FALSE;
XBOOL tellall = FALSE;
X
Xchar *gtname(filespec)		/* get name component of unix-style filespec */
Xchar *filespec;
X{
X	char *rname, *rindex();
X
X	rname = rindex(filespec,'/');
X
X	if (rname != NULL)
X		return(rname);
X	else
X		return(filespec);
X}
X
Xchar *getpath(filespec)
Xchar *filespec;
X{
X	char rbuff[LFILEN];
X	char *rname, *rindex();
X
X	strcpy(rbuff,filespec);
X	rname = rindex(rbuff,'/');
X
X	if (rname == NULL)
X		return(NULL);
X	else
X	{
X		*(++rname) = '\0';
X		return(rbuff);
X	}
X
X}
X
Xchar *dolock(fname)
X	char *fname;
X{
X	static char lockname[LFILEN] = LOCKDIR;
X	static char username[12];
X	static char lmsg[40] = LOCKMSG;
X	char *pathfmt;
X	struct stat statblk;
X	struct passwd *pblk;
X	long pid, getpid();
X	FILE *lf, *fopen();
X	int oldumask;
X
X	oldumask = umask(0);	/* maximum access allowed to lock files */
X
X
X	  if (*fname != '/')
X	   pathfmt = "./%s%s";
X	  else
X	   pathfmt = "%s/%s";
X	  sprintf(lockname,pathfmt,getpath(fname), LOCKDIR);
X
X	  if (tellall) printf("checking for existence of %s\n",lockname);
X
X	  if (stat(lockname,&statblk))
X	  {
X		 if (tellall) printf("making directory %s\n",lockname);
X		 mkdir(lockname,0777); 
X	  }
X
X	  sprintf(lockname,"%s/%s",lockname,gtname(fname));
X
X	  if (tellall) printf("checking for existence of %s\n",lockname);
X
X	  if (stat(lockname,&statblk))
X	  {
Xmakelock:  	if (tellall) printf("creating %s\n",lockname);
X
X		if ((lf = fopen(lockname,FOP_TW)) == NULL)
X		  LOCKERR("could not create lock file")
X	        else
X	  	{
X			if (parent)
X			 pid = getppid();	/* parent pid */
X			else
X			 pid = getpid();	/* current pid */
X
X			 if (tellall)
X			  printf("pid is %ld\n",pid); 
X
X			 fprintf(lf,"%ld",pid); /* write pid to lock file */
X
X			fclose(lf);
X			oldumask = umask(oldumask);
X			return(NULL);
X		}
X	  }
X	  else
X	  {
X		if (tellall) printf("reading lock file %s\n",lockname);
X		if ((lf = fopen(lockname,FOP_TR)) == NULL)
X		  LOCKERR("could not read lock file")
X	        else
X	  	{
X			fscanf(lf,"%ld",&pid); /* contains current pid */
X			fclose(lf);
X			if (tellall)
X			 printf("pid in %s is %ld\n",lockname, pid);
X			if (tellall)
X			 printf("signaling process %ld\n", pid);
X			if (kill(pid,0))
X				switch (errno)
X				{
X				  case ESRCH:	/* process not found */
X						goto makelock;
X						break;
X				  case EPERM:	/* process exists, not yours */
X			 			if (tellall) 
X						 puts("process exists");
X						break;
X				  default:
X					LOCKERR("kill was bad")
X					break;
X				}
X			else
X			 if (tellall) puts("kill was good; process exists");
X		}
X		if ((pblk = getpwuid(statblk.st_uid)) == NULL)
X		  sprintf(username,"uid %d",atoi(statblk.st_uid));
X		else
X		  strcpy(username,pblk->pw_name);
X
X		oldumask = umask(oldumask);
X		return(username);
X	  }
X}
X
X/**********************
X *
X * undolock -- unlock the file fname
X *
X * if successful, returns NULL 
X * if other error, returns "LOCK ERROR: explanation"
X *
X * Jon Reid, 2/19/86
X *
X *********************/
X
Xchar *undolock(fname)
X	char *fname;
X{
X	static char lockname[LFILEN] = LOCKDIR;
X	static char lmsg[40] = LOCKMSG;
X	char *pathfmt;
X
X	  if (*fname != '/')
X	   pathfmt = "./%s%s";
X	  else
X	   pathfmt = "%s/%s";
X	  sprintf(lockname,pathfmt,getpath(fname), LOCKDIR);
X
X	  sprintf(lockname,"%s/%s",lockname,gtname(fname));
X
X	  if (tellall) printf("attempting to unlink %s\n",lockname);
X
X	  if (unlink(lockname))
X	  { 
X		strcat(lmsg,"could not remove lock file"); 
X		return(lmsg); 
X	  }
X	  else
X	  	  return(NULL);
X}
X
X#endif
X
X/******************
X * end dolock module
X *******************/
X
X#else
Xdolhello()
X{
X}
X#endif
X
FRIDAY_NIGHT
echo extracting - eval.c
sed 's/^X//' > eval.c << 'FRIDAY_NIGHT'
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
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	register char *tsp;		/* temporary string pointer */
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	char *flook();			/* look file up on path */
X	char *xlat();			/* translate a char string */
X#if	ENVFUNC
X	char *getenv();			/* get environment string */
X#endif
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,
X					&arg1[(strlen(arg1) - atoi(arg2))]));
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(strcpy(result, 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		case UFSINDEX:	return(itoa(sindex(arg1, arg2)));
X		case UFENV:
X#if	ENVFUNC
X				tsp = getenv(arg1);
X				return(tsp == NULL ? "" : tsp);
X#else
X				return("");
X#endif
X		case UFBIND:	return(transbind(arg1));
X		case UFEXIST:	return(ltos(fexist(arg1)));
X		case UFFIND:
X				tsp = flook(arg1, TRUE);
X				return(tsp == NULL ? "" : tsp);
X 		case UFBAND:	return(itoa(atoi(arg1) & atoi(arg2)));
X 		case UFBOR:	return(itoa(atoi(arg1) | atoi(arg2)));
X 		case UFBXOR:	return(itoa(atoi(arg1) ^ atoi(arg2)));
X		case UFBNOT:	return(itoa(~atoi(arg1)));
X		case UFXLATE:	return(xlat(arg1, arg2, arg3));
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 (uv[vnum].u_name[0] == 0)
X			return(errorm);
X		if (strcmp(vname, uv[vnum].u_name) == 0)
X			return(uv[vnum].u_value);
X	}
X
X	/* return errorm if we run off the end */
X	return(errorm);
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	char *getkill();
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)));
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_ncol));
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:
X			return(curwp->w_dotp->l_used ==
X					curwp->w_doto ? itoa('\n') :
X				itoa(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		case EVWLINE:	return(itoa(curwp->w_ntrows));
X		case EVCWLINE:	return(itoa(getwpos()));
X		case EVTARGET:	saveflag = lastflag;
X				return(itoa(curgoal));
X		case EVSEARCH:	return(pat);
X		case EVREPLACE:	return(rpat);
X		case EVMATCH:	return((patmatch == NULL)? "": patmatch);
X		case EVKILL:	return(getkill());
X		case EVCMODE:	return(itoa(curbp->b_mode));
X		case EVGMODE:	return(itoa(gmode));
X		case EVTPAUSE:	return(itoa(term.t_pause));
X		case EVPENDING:
X#if	TYPEAH
X				return(ltos(typahead()));
X#else
X				return(falsem);
X#endif
X		case EVLWIDTH:	return(itoa(llength(curwp->w_dotp)));
X		case EVLINE:	return(getctext());
X		case EVGFLAGS:	return(itoa(gflags));
X		case EVRVAL:	return(itoa(rval));
X	}
X	exit(-12);	/* again, we should never get here */
X}
X
Xchar *getkill()		/* return some of the contents of the kill buffer */
X
X{
X	register int size;	/* max number of chars to return */
X	char value[NSTRING];	/* temp buffer for value */
X
X	if (kbufh == NULL)
X		/* no kill buffer....just a null string */
X		value[0] = 0;
X	else {
X		/* copy in the contents... */
X		if (kused < NSTRING)
X			size = kused;
X		else
X			size = NSTRING - 1;
X		strncpy(value, kbufh->d_chunk, size);
X	}
X
X	/* and return the constructed value */
X	return(value);
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 status;	/* status return */
X#if	DEBUGM
X	register char *sp;	/* temp string pointer */
X	register char *ep;	/* ptr to end of outline */
X#endif
X	VDESC vd;		/* variable num/type */
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, NVSIZE + 1);
X	}
X
X	/* check the legality and find the var */
X	findvar(var, &vd, NVSIZE + 1);
X	
X	/* if its not legal....bitch */
X	if (vd.v_type == -1) {
X		mlwrite("%%No such variable as '%s'", var);
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 = svar(&vd, value);
X
X#if	DEBUGM
X	/* if $debug == TRUE, every assignment will echo a statment to
X	   that effect here. */
X	
X	if (macbug) {
X		strcpy(outline, "(((");
X
X		/* assignment status */
X		strcat(outline, ltos(status));
X		strcat(outline, ":");
X
X		/* variable name */
X		strcat(outline, var);
X		strcat(outline, ":");
X
X		/* and lastly the value we tried to assign */
X		strcat(outline, value);
X		strcat(outline, ")))");
X
X		/* expand '%' to "%%" so mlwrite wont bitch */
X		sp = outline;
X		while (*sp)
X			if (*sp++ == '%') {
X				/* advance to the end */
X				ep = --sp;
X				while (*ep++)
X					;
X				/* null terminate the string one out */
X				*(ep + 1) = 0;
X				/* copy backwards */
X				while(ep-- > sp)
X					*(ep + 1) = *ep;
X
X				/* and advance sp past the new % */
X				sp += 2;					
X			}
X
X		/* write out the debug line */
X		mlforce(outline);
X		update(TRUE);
X
X		/* and get the keystroke to hold the output */
X		if (get1key() == abortc) {
X			mlforce("[Macro aborted]");
X			status = FALSE;
X		}
X	}
X#endif
X
X	/* and return it */
X	return(status);
X}
X
Xfindvar(var, vd, size)	/* find a variables type and name */
X
Xchar *var;	/* name of var to get */
XVDESC *vd;	/* structure to hold type and ptr */
Xint size;	/* size of var array */
X
X{
X	register int vnum;	/* subscript in varable arrays */
X	register int vtype;	/* type to return */
X
Xfvar:	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, size);
X				strcpy(var, getval(var));
X				goto fvar;
X			}
X	}
X
X	/* return the results */
X	vd->v_num = vnum;
X	vd->v_type = vtype;
X	return;
X}
X
Xint svar(var, value)		/* set a variable */
X
XVDESC *var;	/* variable to set */
Xchar *value;	/* value to set to */
X
X{
X	register int vnum;	/* ordinal number of var refrenced */
X	register int vtype;	/* type of variable to set */
X	register int status;	/* status return */
X	register int c;		/* translated character */
X	register char * sp;	/* scratch string pointer */
X
X	/* simplify the vd structure (we are gonna look at it a lot) */
X	vnum = var->v_num;
X	vtype = var->v_type;
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(1L, FALSE);	/* delete 1 char */
X				c = atoi(value);
X				if (c == '\n')
X					lnewline(FALSE, 1);
X				else
X					linsert(1, c);
X				backchar(FALSE, 1);
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		case EVWLINE:	status = resize(TRUE, atoi(value));
X				break;
X		case EVCWLINE:	status = forwline(TRUE,
X						atoi(value) - getwpos());
X				break;
X		case EVTARGET:	curgoal = atoi(value);
X				thisflag = saveflag;
X				break;
X		case EVSEARCH:	strcpy(pat, value);
X				rvstrcpy(tap, pat);
X#if	MAGIC
X				mcclear();
X#endif
X				break;
X		case EVREPLACE:	strcpy(rpat, value);
X				break;
X		case EVMATCH:	break;
X		case EVKILL:	break;
X		case EVCMODE:	curbp->b_mode = atoi(value);
X				curwp->w_flag |= WFMODE;
X				break;
X		case EVGMODE:	gmode = atoi(value);
X				break;
X		case EVTPAUSE:	term.t_pause = atoi(value);
X				break;
X		case EVPENDING:	break;
X		case EVLWIDTH:	break;
X		case EVLINE:	putctext(value);
X		case EVGFLAGS:	gflags = atoi(value);
X				break;
X		case EVRVAL:	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	/* 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	do {
X		digit = i % 10;
X		*(--sp) = '0' + digit;	/* and install the new digit */
X		i = i / 10;
X	} while (i);
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	register int distmp;	/* temporary discmd flag */
X	static 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				distmp = discmd;	/* echo it always! */
X				discmd = TRUE;
X				status = getstring(token,
X					   buf, NSTRING, ctoec('\n'));
X				discmd = distmp;
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(errorm);
X		case TKLIT:	return(token);
X		case TKSTR:	return(token+1);
X		case TKCMD:	return(token);
X	}
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}
X
Xint sindex(source, pattern)	/* find pattern within source */
X
Xchar *source;	/* source string to search */
Xchar *pattern;	/* string to look for */
X
X{
X	char *sp;	/* ptr to current position to scan */
X	char *csp;	/* ptr to source string during comparison */
X	char *cp;	/* ptr to place to check for equality */
X
X	/* scanning through the source string */
X	sp = source;
X	while (*sp) {
X		/* scan through the pattern */
X		cp = pattern;
X		csp = sp;
X		while (*cp) {
X			if (!eq(*cp, *csp))
X				break;
X			++cp;
X			++csp;
X		}
X
X		/* was it a match? */
X		if (*cp == 0)
X			return((int)(sp - source) + 1);
X		++sp;
X	}
X
X	/* no match at all.. */
X	return(0);
X}
X
X/*	Filter a string through a translation table	*/
X
Xchar *xlat(source, lookup, trans)
X
Xchar *source;	/* string to filter */
Xchar *lookup;	/* characters to translate */
Xchar *trans;	/* resulting translated characters */
X
X{
X	register char *sp;	/* pointer into source table */
X	register char *lp;	/* pointer into lookup table */
X	register char *rp;	/* pointer into result */
X	static char result[NSTRING];	/* temporary result */
X
X	/* scan source string */
X	sp = source;
X	rp = result;
X	while (*sp) {
X		/* scan lookup table for a match */
X		lp = lookup;
X		while (*lp) {
X			if (*sp == *lp) {
X				*rp++ = trans[lp - lookup];
X				goto xnext;
X			}
X			++lp;
X		}
X
X		/* no match, copy in the source char untranslated */
X		*rp++ = *sp;
X
Xxnext:		++sp;
X	}
X
X	/* terminate and return the result */
X	*rp = 0;
X	return(result);
X}
FRIDAY_NIGHT
echo mes.4 completed!
# That's all folks!