Relay-Version: version B 2.10 5/3/83; site utzoo.UUCP
Path: utzoo!mnetor!seismo!rutgers!sri-unix!ctnews!pyramid!uccba!hal!ncoast!allbery
From: davidsen@steinmetz.UUCP (William E. Davidsen Jr)
Newsgroups: comp.sources.misc
Subject: memacs 3.8i 8 of 11
Message-ID: <2663@ncoast.UUCP>
Date: Mon, 15-Jun-87 15:05:46 EDT
Article-I.D.: ncoast.2663
Posted: Mon Jun 15 15:05:46 1987
Date-Received: Sun, 21-Jun-87 12:42:14 EDT
Sender: allbery@ncoast.UUCP
Lines: 1297
Approved: allbery@ncoast.UUCP
:
#!/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
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; iw_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 */
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; iw_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; iw_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: ", 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
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(®ion)) != 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(®ion)) != 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(®ion)) != 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(®ion)) != 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