Usenet 1994 October/usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso/misc/volume1/8711/microemacs-3.9/9

Text File | 1987-11-17 | 32KB | 1,183 lines

Article 85 of comp.sources.misc:
Path: tut!osu-cis!cbosgd!mandrill!hal!ncoast!allbery
From: [e-mail] (Daniel Lawrence)
Newsgroups: comp.sources.misc
Subject: MicroEmacs 3.9 (Part 9 of 16)
Message-ID: <[e-mail]>
Date: 17 Nov 87 02:32:45 GMT
Sender: [e-mail]
Lines: 1168
Approved: [e-mail]
X-Archive: comp.sources.misc/microemacs-3.9/8

# This is a shar archive.
# Remove everything above this line.
# Run the file through sh, not csh.
# (type `sh mes.9')
# If you do not see the message
#    `mes.9 completed!'
# then the file was incomplete.
echo extracting - random.c
sed 's/^X//' > random.c << 'FRIDAY_NIGHT'
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
X    /* set us at the new position */
X    curwp->w_doto = i;
X
X    /* and tell weather we made it */
X    return(col >= pos);
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(1L, 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((long)(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    linstr(ichar);
X
X    /* and one more tab for a brace */
X    if (bracef)
X        tab(FALSE, 1);
X
X    return(TRUE);
X}
X
X#if    NBRACE
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 oc;    /* caractere oppose a c */
X    register int i, count;
X    register int target;    /* column brace should go after */
X    register LINE *oldlp;
X    register int  oldoff;
X
X    /* if we aren't at the beginning of the line... */
X    if (curwp->w_doto != 0)
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    /* chercher le caractere oppose correspondant */
X    switch (c) {
X        case '}': oc = '{'; break;
X        case ']': oc = '['; break;
X        case ')': oc = '('; break;
X        default: return(FALSE);
X    }
X
X    oldlp = curwp->w_dotp;
X    oldoff = curwp->w_doto;
X
X    count = 1; backchar(FALSE, 1);
X
X    while (count > 0) {
X        if (curwp->w_doto == llength(curwp->w_dotp))
X            ch = '\n';
X        else
X            ch = lgetc(curwp->w_dotp, curwp->w_doto);
X
X        if (ch == c)  ++count;
X        if (ch == oc) --count;
X
X        backchar(FALSE, 1);
X        if (boundry(curwp->w_dotp, curwp->w_doto, REVERSE))
X            break;
X    }
X
X    if (count != 0) {    /* no match */
X        curwp->w_dotp = oldlp;
X        curwp->w_doto = oldoff;
X        return(linsert(n, c));
X    }
X
X    curwp->w_doto = 0;        /* debut de ligne */
X    /* aller au debut de la ligne apres la tabulation */
X    while ((ch = lgetc(curwp->w_dotp, curwp->w_doto)) == ' ' || ch == '\t')
X        forwchar(FALSE, 1);
X
X    /* delete back first */
X    target = getccol(FALSE);    /* c'est l'indent que l'on doit avoir */
X    curwp->w_dotp = oldlp;
X    curwp->w_doto = oldoff;
X
X    while (target != getccol(FALSE)) {
X        if (target < getccol(FALSE))    /* on doit detruire des caracteres */
X            while (getccol(FALSE) > target)
X                backdel(FALSE, 1);
X        else {                /* on doit en inserer */
X            while (target - getccol(FALSE) >= 8)
X                linsert(1,'\t');
X            linsert(target - getccol(FALSE), ' ');
X        }
X    }
X
X    /* and insert the required brace(s) */
X    return(linsert(n, c));
X}
X#else
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#endif
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 int 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                    curbp->b_mode |= (1 << i);
X            else
X                if (global)
X                    gmode &= ~(1 << i);
X                else
X                    curbp->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    mlforce("");
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
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    /* write the message out */
X    mlforce(nbuf);
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 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-- && (status = linstr(tstring)))
X        ;
X    return(status);
X}
X
Xovstring(f, n)    /* ask for and overwite a string into the current
X           buffer at the current point */
X
Xint f, n;    /* ignored arguments */
X
X{
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 overwrite<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-- && (status = lover(tstring)))
X        ;
X    return(status);
X}
X
FRIDAY_NIGHT
echo mes.9 completed!
# That's all folks!