[comp.sources.misc] memacs 3.8i 8 of 11

davidsen@steinmetz.UUCP (William E. Davidsen Jr) (06/15/87)

:
#!/bin/sh
# shar+ created from directory /usr2/davidsen/emacs38i
# 13:42 on Thu Jun 11, 1987 by davidsen
echo 'x - random.c (text)'
sed << 'E!O!F' 's/^X//' > random.c
X/*
X * This file contains the command processing functions for a number of random
X * commands. There is no functional grouping here, for sure.
X */
X
X#include        <stdio.h>
X#include	"estruct.h"
X#include        "edef.h"
X
Xint     tabsize;                        /* Tab size (0: use real tabs)  */
X
X/*
X * Set fill column to n.
X */
Xsetfillcol(f, n)
X{
X        fillcol = n;
X	mlwrite("[Fill column is %d]",n);
X        return(TRUE);
X}
X
X/*
X * Display the current position of the cursor, in origin 1 X-Y coordinates,
X * the character that is under the cursor (in hex), and the fraction of the
X * text that is before the cursor. The displayed column is not the current
X * column, but the column that would be used on an infinite width display.
X * Normally this is bound to "C-X =".
X */
Xshowcpos(f, n)
X{
X        register LINE   *lp;		/* current line */
X        register long   numchars;	/* # of chars in file */
X        register int	numlines;	/* # of lines in file */
X        register long   predchars;	/* # chars preceding point */
X        register int	predlines;	/* # lines preceding point */
X        register int    curchar;	/* character under cursor */
X        int ratio;
X        int col;
X	int savepos;			/* temp save for current offset */
X	int ecol;			/* column pos/end of current line */
X
X	/* starting at the beginning of the buffer */
X        lp = lforw(curbp->b_linep);
X
X	/* start counting chars and lines */
X        numchars = 0;
X        numlines = 0;
X        while (lp != curbp->b_linep) {
X		/* if we are on the current line, record it */
X		if (lp == curwp->w_dotp) {
X			predlines = numlines;
X			predchars = numchars + curwp->w_doto;
X			if ((curwp->w_doto) == llength(lp))
X				curchar = '\n';
X			else
X				curchar = lgetc(lp, curwp->w_doto);
X		}
X		/* on to the next line */
X		++numlines;
X		numchars += llength(lp) + 1;
X		lp = lforw(lp);
X        }
X
X	/* if at end of file, record it */
X	if (curwp->w_dotp == curbp->b_linep) {
X		predlines = numlines;
X		predchars = numchars;
X	}
X
X	/* Get real column and end-of-line column. */
X	col = getccol(FALSE);
X	savepos = curwp->w_doto;
X	curwp->w_doto = llength(curwp->w_dotp);
X	ecol = getccol(FALSE);
X	curwp->w_doto = savepos;
X
X        ratio = 0;              /* Ratio before dot. */
X        if (numchars != 0)
X                ratio = (100L*predchars) / numchars;
X
X	/* summarize and report the info */
X	mlwrite("Line %d/%d Col %d/%d Char %D/%D (%d%%) char = 0x%x",
X		predlines+1, numlines+1, col, ecol,
X		predchars, numchars, ratio, curchar);
X        return (TRUE);
X}
X
Xgetcline()	/* get the current line number */
X
X{
X        register LINE   *lp;		/* current line */
X        register int	numlines;	/* # of lines before point */
X
X	/* starting at the beginning of the buffer */
X        lp = lforw(curbp->b_linep);
X
X	/* start counting lines */
X        numlines = 0;
X        while (lp != curbp->b_linep) {
X		/* if we are on the current line, record it */
X		if (lp == curwp->w_dotp)
X			break;
X		++numlines;
X		lp = lforw(lp);
X        }
X
X	/* and return the resulting count */
X	return(numlines + 1);
X}
X
X/*
X * Return current column.  Stop at first non-blank given TRUE argument.
X */
Xgetccol(bflg)
Xint bflg;
X{
X        register int c, i, col;
X        col = 0;
X        for (i=0; i<curwp->w_doto; ++i) {
X                c = lgetc(curwp->w_dotp, i);
X                if (c!=' ' && c!='\t' && bflg)
X                        break;
X                if (c == '\t')
X                        col |= 0x07;
X                else if (c<0x20 || c==0x7F)
X                        ++col;
X                ++col;
X        }
X        return(col);
X}
X
X/*
X * Set current column.
X */
Xsetccol(pos)
X
Xint pos;	/* position to set cursor */
X
X{
X        register int c;		/* character being scanned */
X	register int i;		/* index into current line */
X	register int col;	/* current cursor column   */
X	register int llen;	/* length of line in bytes */
X
X	col = 0;
X	llen = llength(curwp->w_dotp);
X
X	/* scan the line until we are at or past the target column */
X	for (i = 0; i < llen; ++i) {
X		/* upon reaching the target, drop out */
X		if (col >= pos)
X			break;
X
X		/* advance one character */
X                c = lgetc(curwp->w_dotp, i);
X                if (c == '\t')
X                        col |= 0x07;
X                else if (c<0x20 || c==0x7F)
X                        ++col;
X                ++col;
X        }
X	/* if not long enough... */
X	if (col < pos)
X		return(FALSE);
X
X	/* otherwise...set us at the new position */
X	curwp->w_doto = i;
X	return(TRUE);
X}
X
X/*
X * Twiddle the two characters on either side of dot. If dot is at the end of
X * the line twiddle the two characters before it. Return with an error if dot
X * is at the beginning of line; it seems to be a bit pointless to make this
X * work. This fixes up a very common typo with a single stroke. Normally bound
X * to "C-T". This always works within a line, so "WFEDIT" is good enough.
X */
Xtwiddle(f, n)
X{
X        register LINE   *dotp;
X        register int    doto;
X        register int    cl;
X        register int    cr;
X
X	if (curbp->b_mode&MDVIEW)	/* don't allow this command if	*/
X		return(rdonly());	/* we are in read only mode	*/
X        dotp = curwp->w_dotp;
X        doto = curwp->w_doto;
X        if (doto==llength(dotp) && --doto<0)
X                return (FALSE);
X        cr = lgetc(dotp, doto);
X        if (--doto < 0)
X                return (FALSE);
X        cl = lgetc(dotp, doto);
X        lputc(dotp, doto+0, cr);
X        lputc(dotp, doto+1, cl);
X        lchange(WFEDIT);
X        return (TRUE);
X}
X
X/*
X * Quote the next character, and insert it into the buffer. All the characters
X * are taken literally, with the exception of the newline, which always has
X * its line splitting meaning. The character is always read, even if it is
X * inserted 0 times, for regularity. Bound to "C-Q"
X */
Xquote(f, n)
X{
X        register int    s;
X        register int    c;
X
X	if (curbp->b_mode&MDVIEW)	/* don't allow this command if	*/
X		return(rdonly());	/* we are in read only mode	*/
X        c = tgetc();
X        if (n < 0)
X                return (FALSE);
X        if (n == 0)
X                return (TRUE);
X        if (c == '\n') {
X                do {
X                        s = lnewline();
X                } while (s==TRUE && --n);
X                return (s);
X        }
X        return (linsert(n, c));
X}
X
X/*
X * Set tab size if given non-default argument (n <> 1).  Otherwise, insert a
X * tab into file.  If given argument, n, of zero, change to true tabs.
X * If n > 1, simulate tab stop every n-characters using spaces. This has to be
X * done in this slightly funny way because the tab (in ASCII) has been turned
X * into "C-I" (in 10 bit code) already. Bound to "C-I".
X */
Xtab(f, n)
X{
X        if (n < 0)
X                return (FALSE);
X        if (n == 0 || n > 1) {
X                tabsize = n;
X                return(TRUE);
X        }
X        if (! tabsize)
X                return(linsert(1, '\t'));
X        return(linsert(tabsize - (getccol(FALSE) % tabsize), ' '));
X}
X
X#if	AEDIT
Xdetab(f, n)		/* change tabs to spaces */
X
Xint f,n;	/* default flag and numeric repeat count */
X
X{
X	register int inc;	/* increment to next line [sgn(n)] */
X
X	if (curbp->b_mode&MDVIEW)	/* don't allow this command if	*/
X		return(rdonly());	/* we are in read only mode	*/
X
X	if (f == FALSE)
X		n = 1;
X
X	/* loop thru detabbing n lines */
X	inc = ((n > 0) ? 1 : -1);
X	while (n) {
X		curwp->w_doto = 0;	/* start at the beginning */
X
X		/* detab the entire current line */
X		while (curwp->w_doto < llength(curwp->w_dotp)) {
X			/* if we have a tab */
X			if (lgetc(curwp->w_dotp, curwp->w_doto) == '\t') {
X				ldelete(1, FALSE);
X				insspace(TRUE, 8 - (curwp->w_doto & 7));
X			}
X			forwchar(FALSE, 1);
X		}
X
X		/* advance/or back to the next line */
X		forwline(TRUE, inc);
X		n -= inc;
X	}
X	curwp->w_doto = 0;	/* to the begining of the line */
X	thisflag &= ~CFCPCN;	/* flag that this resets the goal column */
X	lchange(WFEDIT);	/* yes, we have made at least an edit */
X	return(TRUE);
X}
X
Xentab(f, n)		/* change spaces to tabs where posible */
X
Xint f,n;	/* default flag and numeric repeat count */
X
X{
X	register int inc;	/* increment to next line [sgn(n)] */
X	register int fspace;	/* pointer to first space if in a run */
X	register int ccol;	/* current cursor column */
X	register char cchar;	/* current character */
X
X	if (curbp->b_mode&MDVIEW)	/* don't allow this command if	*/
X		return(rdonly());	/* we are in read only mode	*/
X
X	if (f == FALSE)
X		n = 1;
X
X	/* loop thru entabbing n lines */
X	inc = ((n > 0) ? 1 : -1);
X	while (n) {
X		curwp->w_doto = 0;	/* start at the beginning */
X
X		/* entab the entire current line */
X		fspace = -1;
X		ccol = 0;
X		while (curwp->w_doto < llength(curwp->w_dotp)) {
X			/* see if it is time to compress */
X			if ((fspace >= 0) && (nextab(fspace) <= ccol))
X				if (ccol - fspace < 2)
X					fspace = -1;
X				else {
X		/* there is a bug here dealing with mixed space/tabed
X		   lines.......it will get fixed		*/
X					backchar(TRUE, ccol - fspace);
X					ldelete(ccol - fspace, FALSE);
X					linsert(1, '\t');	
X					fspace = -1;
X				}
X
X			/* get the current character */
X			cchar = lgetc(curwp->w_dotp, curwp->w_doto);
X
X			switch (cchar) {
X				case '\t': /* a tab...count em up */
X					ccol = nextab(ccol);
X					break;
X
X				case ' ':  /* a space...compress? */
X					if (fspace == -1)
X						fspace = ccol;
X					ccol++;
X					break;
X
X				default:   /* any other char...just count */
X					ccol++;
X					fspace = -1;
X					break;
X			}
X			forwchar(FALSE, 1);
X		}
X
X		/* advance/or back to the next line */
X		forwline(TRUE, inc);
X		n -= inc;
X	}
X	curwp->w_doto = 0;	/* to the begining of the line */
X	thisflag &= ~CFCPCN;	/* flag that this resets the goal column */
X	lchange(WFEDIT);	/* yes, we have made at least an edit */
X	return(TRUE);
X}
X
Xtrim(f, n)	/* trim trailing whitespace from the point to eol */
X
Xint f,n;	/* default flag and numeric repeat count */
X
X{
X	register LINE *lp;	/* current line pointer */
X	register int offset;	/* original line offset position */
X	register int length;	/* current length */
X	register int inc;	/* increment to next line [sgn(n)] */
X
X	if (curbp->b_mode&MDVIEW)	/* don't allow this command if	*/
X		return(rdonly());	/* we are in read only mode	*/
X
X	if (f == FALSE)
X		n = 1;
X
X	/* loop thru trimming n lines */
X	inc = ((n > 0) ? 1 : -1);
X	while (n) {
X		lp = curwp->w_dotp;		/* find current line text */
X		offset = curwp->w_doto;		/* save original offset */
X		length = lp->l_used;		/* find current length */
X
X		/* trim the current line */
X		while (length > offset) {
X			if (lgetc(lp, length-1) != ' ' &&
X			    lgetc(lp, length-1) != '\t')
X			    	break;
X			length--;
X		}
X		lp->l_used = length;
X
X		/* advance/or back to the next line */
X		forwline(TRUE, inc);
X		n -= inc;
X	}
X	lchange(WFEDIT);
X	thisflag &= ~CFCPCN;	/* flag that this resets the goal column */
X	return(TRUE);
X}
X#endif
X
X/*
X * Open up some blank space. The basic plan is to insert a bunch of newlines,
X * and then back up over them. Everything is done by the subcommand
X * procerssors. They even handle the looping. Normally this is bound to "C-O".
X */
Xopenline(f, n)
X{
X        register int    i;
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 (n < 0)
X                return (FALSE);
X        if (n == 0)
X                return (TRUE);
X        i = n;                                  /* Insert newlines.     */
X        do {
X                s = lnewline();
X        } while (s==TRUE && --i);
X        if (s == TRUE)                          /* Then back up overtop */
X                s = backchar(f, n);             /* of them all.         */
X        return (s);
X}
X
X/*
X * Insert a newline. Bound to "C-M". If we are in CMODE, do automatic
X * indentation as specified.
X */
Xnewline(f, n)
X{
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 (n < 0)
X		return (FALSE);
X
X	/* if we are in C mode and this is a default <NL> */
X	if (n == 1 && (curbp->b_mode & MDCMOD) &&
X	    curwp->w_dotp != curbp->b_linep)
X		return(cinsert());
X
X        /*
X         * If a newline was typed, fill column is defined, the argument is non-
X         * negative, wrap mode is enabled, and we are now past fill column,
X	 * and we are not read-only, perform word wrap.
X         */
X        if ((curwp->w_bufp->b_mode & MDWRAP) && fillcol > 0 &&
X	    getccol(FALSE) > fillcol &&
X	    (curwp->w_bufp->b_mode & MDVIEW) == FALSE)
X		execute(META|SPEC|'W', FALSE, 1);
X
X	/* insert some lines */
X	while (n--) {
X		if ((s=lnewline()) != TRUE)
X			return (s);
X	}
X	return (TRUE);
X}
X
Xcinsert()	/* insert a newline and indentation for C */
X
X{
X	register char *cptr;	/* string pointer into text to copy */
X	register int tptr;	/* index to scan into line */
X	register int bracef;	/* was there a brace at the end of line? */
X	register int i;
X	char ichar[NSTRING];	/* buffer to hold indent of last line */
X
X	/* grab a pointer to text to copy indentation from */
X	cptr = &curwp->w_dotp->l_text[0];
X
X	/* check for a brace */
X	tptr = curwp->w_doto - 1;
X	bracef = (cptr[tptr] == '{');
X
X	/* save the indent of the previous line */
X	i = 0;
X	while ((i < tptr) && (cptr[i] == ' ' || cptr[i] == '\t')
X		&& (i < NSTRING - 1)) {
X		ichar[i] = cptr[i];
X		++i;
X	}
X	ichar[i] = 0;		/* terminate it */
X
X	/* put in the newline */
X	if (lnewline() == FALSE)
X		return(FALSE);
X
X	/* and the saved indentation */
X	i = 0;
X	while (ichar[i])
X		linsert(1, ichar[i++]);
X
X	/* and one more tab for a brace */
X	if (bracef)
X		tab(FALSE, 1);
X
X	return(TRUE);
X}
X
Xinsbrace(n, c)	/* insert a brace into the text here...we are in CMODE */
X
Xint n;	/* repeat count */
Xint c;	/* brace to insert (always { for now) */
X
X{
X	register int ch;	/* last character before input */
X	register int i;
X	register int target;	/* column brace should go after */
X
X	/* if we are at the beginning of the line, no go */
X	if (curwp->w_doto == 0)
X		return(linsert(n,c));
X
X	/* scan to see if all space before this is white space */
X	for (i = curwp->w_doto - 1; i >= 0; --i) {
X		ch = lgetc(curwp->w_dotp, i);
X		if (ch != ' ' && ch != '\t')
X			return(linsert(n, c));
X	}
X
X	/* delete back first */
X	target = getccol(FALSE);	/* calc where we will delete to */
X	target -= 1;
X	target -= target % (tabsize == 0 ? 8 : tabsize);
X	while (getccol(FALSE) > target)
X		backdel(FALSE, 1);
X
X	/* and insert the required brace(s) */
X	return(linsert(n, c));
X}
X
Xinspound()	/* insert a # into the text here...we are in CMODE */
X
X{
X	register int ch;	/* last character before input */
X	register int i;
X
X	/* if we are at the beginning of the line, no go */
X	if (curwp->w_doto == 0)
X		return(linsert(1,'#'));
X
X	/* scan to see if all space before this is white space */
X	for (i = curwp->w_doto - 1; i >= 0; --i) {
X		ch = lgetc(curwp->w_dotp, i);
X		if (ch != ' ' && ch != '\t')
X			return(linsert(1, '#'));
X	}
X
X	/* delete back first */
X	while (getccol(FALSE) >= 1)
X		backdel(FALSE, 1);
X
X	/* and insert the required pound */
X	return(linsert(1, '#'));
X}
X
X/*
X * Delete blank lines around dot. What this command does depends if dot is
X * sitting on a blank line. If dot is sitting on a blank line, this command
X * deletes all the blank lines above and below the current line. If it is
X * sitting on a non blank line then it deletes all of the blank lines after
X * the line. Normally this command is bound to "C-X C-O". Any argument is
X * ignored.
X */
Xdeblank(f, n)
X{
X        register LINE   *lp1;
X        register LINE   *lp2;
X        long nld;
X
X	if (curbp->b_mode&MDVIEW)	/* don't allow this command if	*/
X		return(rdonly());	/* we are in read only mode	*/
X        lp1 = curwp->w_dotp;
X        while (llength(lp1)==0 && (lp2=lback(lp1))!=curbp->b_linep)
X                lp1 = lp2;
X        lp2 = lp1;
X        nld = 0;
X        while ((lp2=lforw(lp2))!=curbp->b_linep && llength(lp2)==0)
X                ++nld;
X        if (nld == 0)
X                return (TRUE);
X        curwp->w_dotp = lforw(lp1);
X        curwp->w_doto = 0;
X        return (ldelete(nld, FALSE));
X}
X
X/*
X * Insert a newline, then enough tabs and spaces to duplicate the indentation
X * of the previous line. Assumes tabs are every eight characters. Quite simple.
X * Figure out the indentation of the current line. Insert a newline by calling
X * the standard routine. Insert the indentation by inserting the right number
X * of tabs and spaces. Return TRUE if all ok. Return FALSE if one of the
X * subcomands failed. Normally bound to "C-J".
X */
Xindent(f, n)
X{
X        register int    nicol;
X        register int    c;
X        register int    i;
X
X	if (curbp->b_mode&MDVIEW)	/* don't allow this command if	*/
X		return(rdonly());	/* we are in read only mode	*/
X        if (n < 0)
X                return (FALSE);
X        while (n--) {
X                nicol = 0;
X                for (i=0; i<llength(curwp->w_dotp); ++i) {
X                        c = lgetc(curwp->w_dotp, i);
X                        if (c!=' ' && c!='\t')
X                                break;
X                        if (c == '\t')
X                                nicol |= 0x07;
X                        ++nicol;
X                }
X                if (lnewline() == FALSE
X                || ((i=nicol/8)!=0 && linsert(i, '\t')==FALSE)
X                || ((i=nicol%8)!=0 && linsert(i,  ' ')==FALSE))
X                        return (FALSE);
X        }
X        return (TRUE);
X}
X
X/*
X * Delete forward. This is real easy, because the basic delete routine does
X * all of the work. Watches for negative arguments, and does the right thing.
X * If any argument is present, it kills rather than deletes, to prevent loss
X * of text if typed with a big argument. Normally bound to "C-D".
X */
Xforwdel(f, n)
X{
X	if (curbp->b_mode&MDVIEW)	/* don't allow this command if	*/
X		return(rdonly());	/* we are in read only mode	*/
X        if (n < 0)
X                return (backdel(f, -n));
X        if (f != FALSE) {                       /* Really a kill.       */
X                if ((lastflag&CFKILL) == 0)
X                        kdelete();
X                thisflag |= CFKILL;
X        }
X        return (ldelete((long)n, f));
X}
X
X/*
X * Delete backwards. This is quite easy too, because it's all done with other
X * functions. Just move the cursor back, and delete forwards. Like delete
X * forward, this actually does a kill if presented with an argument. Bound to
X * both "RUBOUT" and "C-H".
X */
Xbackdel(f, n)
X{
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 (n < 0)
X                return (forwdel(f, -n));
X        if (f != FALSE) {                       /* Really a kill.       */
X                if ((lastflag&CFKILL) == 0)
X                        kdelete();
X                thisflag |= CFKILL;
X        }
X        if ((s=backchar(f, n)) == TRUE)
X                s = ldelete((long)n, f);
X        return (s);
X}
X
X/*
X * Kill text. If called without an argument, it kills from dot to the end of
X * the line, unless it is at the end of the line, when it kills the newline.
X * If called with an argument of 0, it kills from the start of the line to dot.
X * If called with a positive argument, it kills from dot forward over that
X * number of newlines. If called with a negative argument it kills backwards
X * that number of newlines. Normally bound to "C-K".
X */
Xkilltext(f, n)
X{
X        register LINE   *nextp;
X        long chunk;
X
X	if (curbp->b_mode&MDVIEW)	/* don't allow this command if	*/
X		return(rdonly());	/* we are in read only mode	*/
X        if ((lastflag&CFKILL) == 0)             /* Clear kill buffer if */
X                kdelete();                      /* last wasn't a kill.  */
X        thisflag |= CFKILL;
X        if (f == FALSE) {
X                chunk = llength(curwp->w_dotp)-curwp->w_doto;
X                if (chunk == 0)
X                        chunk = 1;
X        } else if (n == 0) {
X                chunk = curwp->w_doto;
X                curwp->w_doto = 0;
X        } else if (n > 0) {
X                chunk = llength(curwp->w_dotp)-curwp->w_doto+1;
X                nextp = lforw(curwp->w_dotp);
X                while (--n) {
X                        if (nextp == curbp->b_linep)
X                                return (FALSE);
X                        chunk += llength(nextp)+1;
X                        nextp = lforw(nextp);
X                }
X        } else {
X                mlwrite("neg kill");
X                return (FALSE);
X        }
X        return(ldelete(chunk, TRUE));
X}
X
Xsetmode(f, n)	/* prompt and set an editor mode */
X
Xint f, n;	/* default and argument */
X
X{
X	adjustmode(TRUE, FALSE);
X}
X
Xdelmode(f, n)	/* prompt and delete an editor mode */
X
Xint f, n;	/* default and argument */
X
X{
X	adjustmode(FALSE, FALSE);
X}
X
Xsetgmode(f, n)	/* prompt and set a global editor mode */
X
Xint f, n;	/* default and argument */
X
X{
X	adjustmode(TRUE, TRUE);
X}
X
Xdelgmode(f, n)	/* prompt and delete a global editor mode */
X
Xint f, n;	/* default and argument */
X
X{
X	adjustmode(FALSE, TRUE);
X}
X
Xadjustmode(kind, global)	/* change the editor mode status */
X
Xint kind;	/* true = set,		false = delete */
Xint global;	/* true = global flag,	false = current buffer flag */
X{
X	register char *scan;		/* scanning pointer to convert prompt */
X	register int i;			/* loop index */
X	register status;		/* error return on input */
X#if	COLOR
X	register int uflag;		/* was modename uppercase?	*/
X#endif
X	char prompt[50];	/* string to prompt user with */
X	char cbuf[NPAT];		/* buffer to recieve mode name into */
X
X	/* build the proper prompt string */
X	if (global)
X		strcpy(prompt,"Global mode to ");
X	else
X		strcpy(prompt,"Mode to ");
X
X	if (kind == TRUE)
X		strcat(prompt, "add: ");
X	else
X		strcat(prompt, "delete: ");
X
X	/* prompt the user and get an answer */
X
X	status = mlreply(prompt, cbuf, NPAT - 1);
X	if (status != TRUE)
X		return(status);
X
X	/* make it uppercase */
X
X	scan = cbuf;
X#if	COLOR
X	uflag = (*scan >= 'A' && *scan <= 'Z');
X#endif
X	while (*scan != 0) {
X		if (*scan >= 'a' && *scan <= 'z')
X			*scan = *scan - 32;
X		scan++;
X	}
X
X	/* test it first against the colors we know */
X	for (i=0; i<NCOLORS; i++) {
X		if (strcmp(cbuf, cname[i]) == 0) {
X			/* finding the match, we set the color */
X#if	COLOR
X			if (uflag)
X				if (global)
X					gfcolor = i;
X				else
X					curwp->w_fcolor = i;
X			else
X				if (global)
X					gbcolor = i;
X				else
X					curwp->w_bcolor = i;
X
X			curwp->w_flag |= WFCOLR;
X#endif
X			mlerase();
X			return(TRUE);
X		}
X	}
X
X	/* test it against the modes we know */
X
X	for (i=0; i < NUMMODES; i++) {
X		if (strcmp(cbuf, modename[i]) == 0) {
X			/* finding a match, we process it */
X			if (kind == TRUE)
X				if (global)
X					gmode |= (1 << i);
X				else
X					curwp->w_bufp->b_mode |= (1 << i);
X			else
X				if (global)
X					gmode &= ~(1 << i);
X				else
X					curwp->w_bufp->b_mode &= ~(1 << i);
X			/* display new mode line */
X			if (global == 0)
X				upmode();
X			mlerase();	/* erase the junk */
X			return(TRUE);
X		}
X	}
X
X	mlwrite("No such mode!");
X	return(FALSE);
X}
X
X/*	This function simply clears the message line,
X		mainly for macro usage			*/
X
Xclrmes(f, n)
X
Xint f, n;	/* arguments ignored */
X
X{
X	mlwrite("");
X	return(TRUE);
X}
X
X/*	This function writes a string on the message line
X		mainly for macro usage			*/
X
Xwritemsg(f, n)
X
Xint f, n;	/* arguments ignored */
X
X{
X	register char *sp;	/* pointer into buf to expand %s */
X	register char *np;	/* ptr into nbuf */
X	register int status;
X	char buf[NPAT];		/* buffer to recieve message into */
X	char nbuf[NPAT*2];	/* buffer to expand string into */
X	int oldcmd;		/* discmd global save value */
X
X	if ((status = mlreply("Message to write: ", buf, NPAT - 1)) != TRUE)
X		return(status);
X
X	/* expand all '%' to "%%" so mlwrite won't expect arguments */
X	sp = buf;
X	np = nbuf;
X	while (*sp) {
X		*np++ = *sp;
X		if (*sp++ == '%')
X			*np++ = '%';
X	}
X	*np = '\0';
X
X	/* save discmd and turn it on */
X	oldcmd = discmd;
X	discmd = TRUE;
X
X	mlwrite(nbuf);
X	discmd = oldcmd;	/* restore discmd */
X	return(TRUE);
X}
X
X#if	CFENCE
X/*	the cursor is moved to a matching fence	*/
X
Xgetfence(f, n)
X
Xint f, n;	/* not used */
X
X{
X	register LINE *oldlp;	/* original line pointer */
X	register int oldoff;	/* and offset */
X	register int sdir;	/* direction of search (1/-1) */
X	register int count;	/* current fence level count */
X	register char ch;	/* fence type to match against */
X	register char ofence;	/* open fence */
X	register char c;	/* current character in scan */
X
X	/* save the original cursor position */
X	oldlp = curwp->w_dotp;
X	oldoff = curwp->w_doto;
X
X	/* get the current character */
X	if (oldoff == llength(oldlp))
X		ch = '\n';
X	else
X		ch = lgetc(oldlp, oldoff);
X
X	/* setup proper matching fence */
X	switch (ch) {
X		case '(': ofence = ')'; sdir = FORWARD; break;
X		case '{': ofence = '}'; sdir = FORWARD; break;
X		case '[': ofence = ']'; sdir = FORWARD; break;
X		case ')': ofence = '('; sdir = REVERSE; break;
X		case '}': ofence = '{'; sdir = REVERSE; break;
X		case ']': ofence = '['; sdir = REVERSE; break;
X		default: TTbeep(); return(FALSE);
X	}
X
X	/* set up for scan */
X	count = 1;
X	if (sdir == REVERSE)
X		backchar(FALSE, 1);
X	else
X		forwchar(FALSE, 1);
X
X	/* scan until we find it, or reach the end of file */
X	while (count > 0) {
X		if (curwp->w_doto == llength(curwp->w_dotp))
X			c = '\n';
X		else
X			c = lgetc(curwp->w_dotp, curwp->w_doto);
X		if (c == ch)
X			++count;
X		if (c == ofence)
X			--count;
X		if (sdir == FORWARD)
X			forwchar(FALSE, 1);
X		else
X			backchar(FALSE, 1);
X		if (boundry(curwp->w_dotp, curwp->w_doto, sdir))
X			break;
X	}
X
X	/* if count is zero, we have a match, move the sucker */
X	if (count == 0) {
X		if (sdir == FORWARD)
X			backchar(FALSE, 1);
X		else
X			forwchar(FALSE, 1);
X		curwp->w_flag |= WFMOVE;
X		return(TRUE);
X	}
X
X	/* restore the current position */
X	curwp->w_dotp = oldlp;
X	curwp->w_doto = oldoff;
X	TTbeep();
X	return(FALSE);
X}
X#endif
X
X/*	Close fences are matched against their partners, and if
X	on screen the cursor briefly lights there		*/
X
Xfmatch(ch)
X
Xchar ch;	/* fence type to match against */
X
X{
X	register LINE *oldlp;	/* original line pointer */
X	register int oldoff;	/* and offset */
X	register LINE *toplp;	/* top line in current window */
X	register int count;	/* current fence level count */
X	register char opench;	/* open fence */
X	register char c;	/* current character in scan */
X	register int i;
X
X	/* first get the display update out there */
X	update(FALSE);
X
X	/* save the original cursor position */
X	oldlp = curwp->w_dotp;
X	oldoff = curwp->w_doto;
X
X	/* setup proper open fence for passed close fence */
X	if (ch == ')')
X		opench = '(';
X	else if (ch == '}')
X		opench = '{';
X	else
X		opench = '[';
X
X	/* find the top line and set up for scan */
X	toplp = curwp->w_linep->l_bp;
X	count = 1;
X	backchar(FALSE, 2);
X
X	/* scan back until we find it, or reach past the top of the window */
X	while (count > 0 && curwp->w_dotp != toplp) {
X		if (curwp->w_doto == llength(curwp->w_dotp))
X			c = '\n';
X		else
X			c = lgetc(curwp->w_dotp, curwp->w_doto);
X		if (c == ch)
X			++count;
X		if (c == opench)
X			--count;
X		backchar(FALSE, 1);
X		if (curwp->w_dotp == curwp->w_bufp->b_linep->l_fp &&
X		    curwp->w_doto == 0)
X			break;
X	}
X
X	/* if count is zero, we have a match, display the sucker */
X	/* there is a real machine dependant timing problem here we have
X	   yet to solve......... */
X	if (count == 0) {
X		forwchar(FALSE, 1);
X		for (i = 0; i < term.t_pause; i++)
X			update(FALSE);
X	}
X
X	/* restore the current position */
X	curwp->w_dotp = oldlp;
X	curwp->w_doto = oldoff;
X	return(TRUE);
X}
X
Xistring(f, n)	/* ask for and insert a string into the current
X		   buffer at the current point */
X
Xint f, n;	/* ignored arguments */
X
X{
X	register char *tp;	/* pointer into string to add */
X	register int status;	/* status return code */
X	char tstring[NPAT+1];	/* string to add */
X
X	/* ask for string to insert */
X	status = mlreplyt("String to insert<META>: ", tstring, NPAT, metac);
X	if (status != TRUE)
X		return(status);
X
X	if (f == FALSE)
X		n = 1;
X
X	if (n < 0)
X		n = - n;
X
X	/* insert it */
X	while (n--) {
X		tp = &tstring[0];
X		while (*tp) {
X			if (*tp == 0x0a)
X				status = lnewline();
X			else
X				status = linsert(1, *tp);
X			++tp;
X			if (status != TRUE)
X				return(status);
X		}
X	}
X
X	return(TRUE);
X}
E!O!F
newsize=`wc -c < random.c`
if [ $newsize -ne 27975 ]
then echo "File random.c was $newsize bytes, 27975 expected"
fi
echo 'x - region.c (text)'
sed << 'E!O!F' 's/^X//' > region.c
X/*
X * The routines in this file
X * deal with the region, that magic space
X * between "." and mark. Some functions are
X * commands. Some functions are just for
X * internal use.
X */
X#include        <stdio.h>
X#include	"estruct.h"
X#include        "edef.h"
X
X#if	MEGAMAX & ST520
Xoverlay	"region"
X#endif
X
X/*
X * Kill the region. Ask "getregion"
X * to figure out the bounds of the region.
X * Move "." to the start, and kill the characters.
X * Bound to "C-W".
X */
Xkillregion(f, n)
X{
X        register int    s;
X        REGION          region;
X
X	if (curbp->b_mode&MDVIEW)	/* don't allow this command if	*/
X		return(rdonly());	/* we are in read only mode	*/
X        if ((s=getregion(&region)) != TRUE)
X                return (s);
X        if ((lastflag&CFKILL) == 0)             /* This is a kill type  */
X                kdelete();                      /* command, so do magic */
X        thisflag |= CFKILL;                     /* kill buffer stuff.   */
X        curwp->w_dotp = region.r_linep;
X        curwp->w_doto = region.r_offset;
X        return (ldelete(region.r_size, TRUE));
X}
X
X/*
X * Copy all of the characters in the
X * region to the kill buffer. Don't move dot
X * at all. This is a bit like a kill region followed
X * by a yank. Bound to "M-W".
X */
Xcopyregion(f, n)
X{
X        register LINE   *linep;
X        register int    loffs;
X        register int    s;
X        REGION          region;
X
X        if ((s=getregion(&region)) != TRUE)
X                return (s);
X        if ((lastflag&CFKILL) == 0)             /* Kill type command.   */
X                kdelete();
X        thisflag |= CFKILL;
X        linep = region.r_linep;                 /* Current line.        */
X        loffs = region.r_offset;                /* Current offset.      */
X        while (region.r_size--) {
X                if (loffs == llength(linep)) {  /* End of line.         */
X                        if ((s=kinsert('\n')) != TRUE)
X                                return (s);
X                        linep = lforw(linep);
X                        loffs = 0;
X                } else {                        /* Middle of line.      */
X                        if ((s=kinsert(lgetc(linep, loffs))) != TRUE)
X                                return (s);
X                        ++loffs;
X                }
X        }
X        return (TRUE);
X}
X
X/*
X * Lower case region. Zap all of the upper
X * case characters in the region to lower case. Use
X * the region code to set the limits. Scan the buffer,
X * doing the changes. Call "lchange" to ensure that
X * redisplay is done in all buffers. Bound to
X * "C-X C-L".
X */
Xlowerregion(f, n)
X{
X        register LINE   *linep;
X        register int    loffs;
X        register int    c;
X        register int    s;
X        REGION          region;
X
X	if (curbp->b_mode&MDVIEW)	/* don't allow this command if	*/
X		return(rdonly());	/* we are in read only mode	*/
X        if ((s=getregion(&region)) != TRUE)
X                return (s);
X        lchange(WFHARD);
X        linep = region.r_linep;
X        loffs = region.r_offset;
X        while (region.r_size--) {
X                if (loffs == llength(linep)) {
X                        linep = lforw(linep);
X                        loffs = 0;
X                } else {
X                        c = lgetc(linep, loffs);
X                        if (c>='A' && c<='Z')
X                                lputc(linep, loffs, c+'a'-'A');
X                        ++loffs;
X                }
X        }
X        return (TRUE);
X}
X
X/*
X * Upper case region. Zap all of the lower
X * case characters in the region to upper case. Use
X * the region code to set the limits. Scan the buffer,
X * doing the changes. Call "lchange" to ensure that
X * redisplay is done in all buffers. Bound to
X * "C-X C-L".
X */
Xupperregion(f, n)
X{
X        register LINE   *linep;
X        register int    loffs;
X        register int    c;
X        register int    s;
X        REGION          region;
X
X	if (curbp->b_mode&MDVIEW)	/* don't allow this command if	*/
X		return(rdonly());	/* we are in read only mode	*/
X        if ((s=getregion(&region)) != TRUE)
X                return (s);
X        lchange(WFHARD);
X        linep = region.r_linep;
X        loffs = region.r_offset;
X        while (region.r_size--) {
X                if (loffs == llength(linep)) {
X                        linep = lforw(linep);
X                        loffs = 0;
X                } else {
X                        c = lgetc(linep, loffs);
X                        if (c>='a' && c<='z')
X                                lputc(linep, loffs, c-'a'+'A');
X                        ++loffs;
X                }
X        }
X        return (TRUE);
X}
X
X/*
X * This routine figures out the
X * bounds of the region in the current window, and
X * fills in the fields of the "REGION" structure pointed
X * to by "rp". Because the dot and mark are usually very
X * close together, we scan outward from dot looking for
X * mark. This should save time. Return a standard code.
X * Callers of this routine should be prepared to get
X * an "ABORT" status; we might make this have the
X * conform thing later.
X */
Xgetregion(rp)
Xregister REGION *rp;
X{
X        register LINE   *flp;
X        register LINE   *blp;
X        long fsize;
X        long bsize;
X
X        if (curwp->w_markp == NULL) {
X                mlwrite("No mark set in this window");
X                return (FALSE);
X        }
X        if (curwp->w_dotp == curwp->w_markp) {
X                rp->r_linep = curwp->w_dotp;
X                if (curwp->w_doto < curwp->w_marko) {
X                        rp->r_offset = curwp->w_doto;
X                        rp->r_size = (long)(curwp->w_marko-curwp->w_doto);
X                } else {
X                        rp->r_offset = curwp->w_marko;
X                        rp->r_size = (long)(curwp->w_doto-curwp->w_marko);
X                }
X                return (TRUE);
X        }
X        blp = curwp->w_dotp;
X        bsize = (long)curwp->w_doto;
X        flp = curwp->w_dotp;
X        fsize = (long)(llength(flp)-curwp->w_doto+1);
X        while (flp!=curbp->b_linep || lback(blp)!=curbp->b_linep) {
X                if (flp != curbp->b_linep) {
X                        flp = lforw(flp);
X                        if (flp == curwp->w_markp) {
X                                rp->r_linep = curwp->w_dotp;
X                                rp->r_offset = curwp->w_doto;
X                                rp->r_size = fsize+curwp->w_marko;
X                                return (TRUE);
X                        }
X                        fsize += llength(flp)+1;
X                }
X                if (lback(blp) != curbp->b_linep) {
X                        blp = lback(blp);
X                        bsize += llength(blp)+1;
X                        if (blp == curwp->w_markp) {
X                                rp->r_linep = blp;
X                                rp->r_offset = curwp->w_marko;
X                                rp->r_size = bsize - curwp->w_marko;
X                                return (TRUE);
X                        }
X                }
X        }
X        mlwrite("Bug: lost mark");
X        return (FALSE);
X}
E!O!F
newsize=`wc -c < region.c`
if [ $newsize -ne 7029 ]
then echo "File region.c was $newsize bytes, 7029 expected"
fi
	bill davidsen		(wedu@ge-crd.arpa)
  {chinet | philabs | sesimo}!steinmetz!crdos1!davidsen
"Stupidity, like virtue, is its own rewa figuip