Source Code 1992 March/Source_Code_CD-ROM_Walnut_Creek_March_1992.iso/usenet/altsrcs/3/3497

Internet Message Format | 1991-06-20 | 54.6 KB

From: [e-mail] (Paul Fox)
Newsgroups: alt.sources
Subject: Vile 11/17 - vi feel-alike (multi-window)
Message-ID: <[e-mail]>
Date: 7 Jun 91 22:09:58 GMT

#!/bin/sh
# this is vileshar.11 (part 11 of Vile)
# do not concatenate these parts, unpack them in order with /bin/sh
# file news.cps continued
#
if test ! -r _shar_seq_.tmp; then
    echo 'Please unpack part 1 first!'
    exit 1
fi
(read Scheck
 if test "$Scheck" != 11; then
    echo Please unpack part "$Scheck" next!
    exit 1
 else
    exit 0
 fi
) < _shar_seq_.tmp || exit 1
echo 'x - continuing file news.cps'
sed 's/^X//' << 'SHAR_EOF' >> 'news.cps' &&
X
X    /prefix_flag false def
X    /prefixes 0 string def
X    /normal_prefixes {
X        /prefixes 2 string store
X        prefixes 0 ESC put
X        prefixes 1 CTRLX put
X    } def
X    /no_prefixes {
X        /prefixes 0 string store
X    } def
X    normal_prefixes
X    /prefix? {    % int => flag        (is char in the set?)
X        chartostring prefixes exch search
X        {pop pop pop true}
X        {pop false}
X        ifelse
X    } def
X
X
X    /times 128 array def        % delay times
X    /default_short .4 def        % command time delay
X    /default_long 2. def        % text time delay
X    /normal_times {
X        0 1 31 {times exch default_short put} for
X        32 1 126 {times exch default_long put} for
X        times 127 default_short put
X    } def
X    normal_times
X
X    /immediateon {
X        {0 1 127 {times exch default_short put} for} win send
X        no_prefixes
X    } def
X    /immediateoff {
X        normal_times
X        normal_prefixes
X    } def
X    /local? {    % int => flag    % local display if long
X        times exch get default_long eq
X    } def
X
X
X    /outtimerrefresh {        % seconds => -    refresh timer
X        /outtimer_seconds exch def
X        currentdict /flushevent known {
X            flushevent recallevent
X        } if
X        /flushevent createevent def
X        flushevent dup begin
X            /Name /Flush def
X            /TimeStamp currenttime
X                outtimer_seconds 60 div add def
X            /Canvas wincanvas def
X        end sendevent
X    } def
X
X
X    % Event handlers.  Routines are invoked with XLocation, YLocation,
X    % and Action on the stack.
X
X    /eventdict dictbegin
X        /LeftMouseButton {    % cutting text
X            /UpTransition eq
X            {    % wipeout
X                /xy_rc win send
X                SPEC addtobuf
X                [exch 3 -1 roll exch (W) ctrl] sendarray
X            }
X            {    % set mark
X                /xy_rc win send
X                SPEC addtobuf
X                [exch 3 -1 roll exch ESC BLANK] sendarray
X                10. outtimerrefresh    % "infinite" wait
X            } ifelse
X        } def
X        /MiddleMouseButton {    % yanking text
X            pop
X            /xy_rc win send
X            SPEC addtobuf
X            [exch 3 -1 roll exch (Y) ctrl] sendarray
X        } def
X        /MouseDragged { pop        % reset "still" timer
X            /yl exch def
X            /xl exch def
X            /mcursorwait win send
X            currentdict /stillevent known {
X                stillevent recallevent
X            } if
X            /stillevent createevent def
X            stillevent dup begin
X                /Name /MouseStill def
X                /TimeStamp currenttime .5 60 div add def
X                /Canvas wincanvas def
X                /Xl xl def
X                /Yl yl def
X            end sendevent
X        } def
X        /InsertValue {
X            dup length 3 sub 2 exch getinterval cvi
X            [exch] sendarray
X            pop pop
X        } def
X        0 1 127 { dup [exch /asciihandler cvx] cvx def } for
X    dictend def
X
X
X
X    % A restricted set handler names, safe on the command line.
X    /keyeventdict dictbegin
X        /InsertValue dup def
X        0 1 127 { dup [exch /asciihandler cvx] cvx def } for
X    dictend def
X
X
X
X    % ordinary character handler (called with Xl, Yl, Action, and code).
X    /asciihandler {
X        /ascii_code exch def pop pop pop
X        prefix_flag
X        {    /prefix_flag false store
X            ascii_code addtobuf
X            default_short outtimerrefresh }
X        {
X            ascii_code prefix?
X            {    /prefix_flag true store
X                ascii_code addtobuf
X                default_long outtimerrefresh }
X            {    ascii_code dup local?
X                    {dup /writechar win send} if
X                addtobuf
X                times ascii_code get outtimerrefresh
X            } ifelse
X
X        } ifelse
X    } def
X
X
X
X    % Send an array of characters to the remote process.
X    /sendarray {        % [(A) ascii (B) ascii] => -
X        {addtobuf} forall
X        default_short outtimerrefresh
X    } def
X
X
X    % Output buffer (accumulate stuff to send to the remote machine).
X    /Outbufdict dictbegin
X        /outbuf 1000 string def
X        /bufindex 0 def
X    dictend def
X
X    /addtobuf {        % int => -    % Add a character
X        Outbufdict begin
X            outbuf bufindex 3 -1 roll put
X            /bufindex bufindex 1 add store
X        end
X    } def
X    /clearbuf {
X        Outbufdict begin
X            /bufindex 0 store
X        end
X    } def
X    /getbuf {
X        Outbufdict begin
X            outbuf 0 bufindex getinterval
X        end
X    } def
X
X
X    % Get a string from the user
X    /getstring {        % - => array
X        createevent dup begin
X            /Name /Flush def
X            /Canvas wincanvas def
X        end expressinterest
X
X        {    awaitevent pop
X            getbuf
X            dup length 0 gt {
X                clearbuf
X                exit
X            } if
X            pop
X        } loop
X    } def
X
X
X
X    % Start her up.
X    {    reshapefromuser
X        trimwindow
X        initwindow
X        ColorDisplay? setcoloring
X        0 1 LastRow {Image exch Cols string put} for
X        starteventtraps
X        cls map
X    } win send
SHAR_EOF
echo 'File news.cps is complete' &&
chmod 0444 news.cps ||
echo 'restore of news.cps failed'
Wc_c="`wc -c < 'news.cps'`"
test 19928 -eq "$Wc_c" ||
    echo 'news.cps: original size 19928, current size' "$Wc_c"
# ============= npopen.c ==============
echo 'x - extracting npopen.c (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'npopen.c' &&
/*    npopen:  like popen, but grabs stderr, too    */
/*        written by John Hutchinson, heavily modified by Paul Fox */
X
#include <stdio.h>
#include "estruct.h"
#include "edef.h"
X
#if UNIX
X
#include <sys/signal.h>
#include <errno.h>
#include <sys/param.h>
X
#if BSD
#define strrchr rindex
#endif
X
#define R 0
#define W 1
X
extern char *getenv();
extern char *strrchr();
X
static int pid;
X
FILE *
npopen (cmd, type)
char *cmd, *type;
{
X    FILE *fr, *fw;
X
X    if (*type != 'r' && *type != 'w')
X        return NULL;
X
X    if (inout_popen(&fr, &fw, cmd) != TRUE)
X        return NULL;
X
X    if (*type == 'r')
X        return fr;
X    else
X        return fw;
}
X
inout_popen(fr, fw, cmd)
FILE **fr, **fw;
char *cmd;
{
X    int tries = 5;
X    unsigned slp = 1;
X    int rp[2];
X    int wp[2];
X    char *sh, *shname;
X
X
X    if (pipe(rp))
X        return FALSE;
X    if (pipe(wp))
X        return FALSE;
X
X    /* Try & fork 5 times, backing off 1, 2, 4 .. seconds each try */
X    while ((pid = fork ()) < 0) {
X        if (--tries == 0)
X            return FALSE;
X        (void) sleep (slp);
X        slp <<= 1;
X    }
X
X    if (pid) { /* parent */
X
X        *fr = fdopen (rp[0], "r");
X        setbuf(*fr,NULL);
X        (void) close (rp[1]);
X
X        *fw = fdopen (wp[1], "w");
X        setbuf(*fw,NULL);
X        (void) close (wp[0]);
X        return TRUE;
X
X    } else {            /* child */
X        int i;
X
X        (void)close (1);
X        if (dup (rp[1]) != 1)
X            exit(-1);
X        (void)close (2);
X        if (dup (rp[1]) != 2)
X            exit(-1);
X        (void)close (0);
X        if (dup (wp[0]) != 0)
X            exit(-1);
X
X        /* Make sure there are no inherited file descriptors */
X        for (i = 3; i < NOFILE; i += 1)
X            (void) close (i);
X
#if ! MY_EXEC
X            if ((sh = getenv("SHELL")) == NULL || *sh == '\0') {
X            sh = "/bin/sh";
X            shname = "sh";
X        } else {
X            shname = strrchr(sh,'/');
X            if (shname == NULL)
X                shname = sh;
X            else {
X                shname++;
X                if (*shname == '\0')
X                    shname = sh;
X            }
X        }
X        (void) execl (sh, shname, "-c", cmd, 0);
#else
X        my_exec(cmd);
#endif
X        exit (-1);
X
X    }
X    return TRUE;
}
X
npclose (fp)
FILE *fp;
{
X    fflush(fp);
X    fclose(fp);
X    if (wait ((int *)0) < 0 && errno == EINTR) {
X        (void) kill (SIGKILL, pid);
X    }
X    return 0;
}
X
#if MY_EXEC
X
static
my_exec (cmd)
register char *cmd;
{
X    char *argv [256];
X    register char **argv_p, *cp;
X
X        if ((argv[0] = getenv("SHELL")) == NULL || argv[0][0] == '\0') {
X        argv[0] = "/bin/sh";
X        argv[1] = "sh";
X    } else {
X        argv[1] = strrchr(argv[0]);
X        if (argv[1] == NULL) {
X            argv[1] = argv[0];
X        } else {
X            argv[1]++;
X            if (argv[1][0] == '\0')
X                argv[1] = argv[0];
X        }
X    }
X    argv[2] = "-c";
X
X    argv_p = &argv[3];
X
X    cp = cmd;
X    /* Scan up cmd, splitting arguments into argv. This is the
X     * child, so we can zap things in cmd safely */
X
X    while (*cp) {
X        /* Skip any white space */
X        while (*cp && isspace(*cp))
X            cp++;
X        if (!*cp)
X            break;
X        *argv_p++ = cp;
X        while (*cp && !isspace(*cp))
X            cp++;
X        if (!*cp)
X            break;
X        *cp++ = '\0';
X    }
X    *argv_p = NULL;
X    execv (argv[0], &argv[1]);
}
#endif
X
#else
npopenhello() {}
#endif
SHAR_EOF
chmod 0444 npopen.c ||
echo 'restore of npopen.c failed'
Wc_c="`wc -c < 'npopen.c'`"
test 2848 -eq "$Wc_c" ||
    echo 'npopen.c: original size 2848, current size' "$Wc_c"
# ============= oneliner.c ==============
echo 'x - extracting oneliner.c (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'oneliner.c' &&
#include    "estruct.h"
#include        "edef.h"
#include        <stdio.h>
X
/*
X    a few functions that operate on single whole lines, mostly
X    here to support the globals() function
X    These could be turned into operators, but they're either not
X    worth it, or a bit tricky
X    written (except for delins()) for vile by Paul Fox, (c)1990
*/
X
#define PLIST    0x01
X
/*
X * put lines in a popup window
X */
pregion(f, n, flag)
{
X    register WINDOW *wp;
X    register BUFFER *bp;
X        register int    s;
X        REGION          region;
X    static char bname[] = "[p-lines]";
X    register LINE *linep;
X    int cb;
X
X    fulllineregions = TRUE;
X
X        if ((s=getregion(®ion,NULL)) != TRUE)
X                return (s);
X
X        linep = region.r_linep;                 /* Current line.        */
X
X    /* first check if we are already here */
X    bp = bfind(bname, OK_CREAT, 0);
X    if (bp == NULL)
X        return FALSE;
X
X    /* bring p-lines up */
X    if (popupbuff(bp) != TRUE)
X        return FALSE;
X
X    if (!calledbefore) {        /* fresh start */
X        bclear(bp);
X        if (flag & PLIST)
X            bp->b_mode |= MDLIST;
X        else
X            bp->b_mode &= ~MDLIST;
X        calledbefore = TRUE;
X    }
X
X    do {
X        addline(bp,linep->l_text,llength(linep));
X        linep = lforw(linep);
X        } while (linep != region.r_endlinep);
X
X    bp->b_flag &= ~BFCHG;
X
X    strcpy(bp->b_bname,bname);
X    strcpy(bp->b_fname, "");
X    bp->b_mode |= MDVIEW;
X    bp->b_active = TRUE;
X        for (wp=wheadp; wp!=NULL; wp=wp->w_wndp) {
X                if (wp->w_bufp == bp) {
X                        wp->w_flag |= WFMODE|WFFORCE;
X                }
X        }
X    return TRUE;
}
X
llineregion(f,n)
{
X    return pregion(f,n,PLIST);
}
X
plineregion(f,n)
{
X    return pregion(f,n,0);
}
X
substregion(f,n)
{
X    int c, s;
X    int foundit;
X    static int printit, globally;
X    REGION region;
X
X    fulllineregions = TRUE;
X
X        if ((s=getregion(®ion,NULL)) != TRUE)
X                return (s);
X
X    c = '\n';
X    if (isnamedcmd) {
X        c = tpeekc();
X        if (c < 0) {
X            c = '\n';
X        } else {
X            if (ispunct(c)) {
X                (void)kbd_key();
X            }
X        }
X    }
X    if (calledbefore == FALSE) {
X        if ((s = readpattern("substitute pattern: ", &pat[0], TRUE, c,
X                FALSE)) != TRUE) {
X            if (s != ABORT)
X                mlwrite("No pattern.");
X            return FALSE;
X        }
X        if ((s = readpattern("replacement string: ", &rpat[0], FALSE, c,
X                FALSE)) != TRUE) {
X            if (s == ABORT)
X                return FALSE;
X            /* else the pattern is null, which is okay... */
X        }
X        if (lastkey == c) {/* the user may have something to add */
X            char buf[3];
X            char *bp = buf;
X            buf[0] = 0;
X            mlreply("(g)lobally on line and/or (p)rint result: ",
X                buf, sizeof buf);
X            printit = globally = FALSE;
X            while (*bp) {
X                if (*bp == 'p' && !printit)
X                    printit = TRUE;
X                else if (*bp == 'g' && !globally)
X                    globally = TRUE;
X                else if (!isspace(*bp)) {
X                    mlwrite("Unknown action %s",buf);
X                    return FALSE;
X                }
X                bp++;
X            }
X        }
X        calledbefore = TRUE;
X    }
X
X
X        curwp->w_dotp = region.r_linep;                 /* Current line.        */
X
X    do {
X        foundit = FALSE;
X        setboundry(TRUE, curwp->w_dotp, llength(curwp->w_dotp), FORWARD);
X        curwp->w_doto = 0;
X        do {
#if    MAGIC
X            if (magical && (curwp->w_bufp->b_mode & MDMAGIC) != 0)
X                s = thescanner(&mcpat[0], FORWARD, PTBEG, TRUE);
X            else
#endif
X                s = thescanner(&pat[0], FORWARD, PTBEG, TRUE);
X            if (s != TRUE)
X                break;
X
X            /* found the pattern */
X            foundit = TRUE;
X            s = delins(matchlen, &rpat[0]);
X            if (s != TRUE)
X                return s;
X            if (boundry(curwp->w_dotp, curwp->w_doto))
X                break;
X        } while (globally);
X        if (foundit && printit) {
X            setmark();
X            s = plineregion(FALSE,1);
X            if (s != TRUE) return s;
X        }
X        curwp->w_dotp = lforw(curwp->w_dotp);
X    } while (curwp->w_dotp != region.r_endlinep);
X    return TRUE;
}
X
/*
X * delins -- Delete a specified length from the current
X *    point, then insert the string.
X *  borrowed from original replaces() code
X */
delins(dlength, instr)
int    dlength;
char    *instr;
{
X    int    status;
X    char    tmpc;
X
X    /* Zap what we gotta,
X     * and insert its replacement.
X     */
X    if (!(status = ldelete((long) dlength, FALSE))) {
X        mlwrite("Error while deleting");
X        return FALSE;
X    } else {
X        while (tmpc = *instr) {
X            status = (tmpc == '\n'? lnewline(): linsert(1, tmpc));
X            if (!status) {
X                mlwrite("Out of memory while inserting");
X                break;
X            }
X            instr++;
X        }
X    }
X    return status;
}
SHAR_EOF
chmod 0444 oneliner.c ||
echo 'restore of oneliner.c failed'
Wc_c="`wc -c < 'oneliner.c'`"
test 4253 -eq "$Wc_c" ||
    echo 'oneliner.c: original size 4253, current size' "$Wc_c"
# ============= opers.c ==============
echo 'x - extracting opers.c (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'opers.c' &&
/*
X * This file contains the command processing functions for the commands
X * that take motion operators.
X * written for vile by Paul Fox, (c)1990
X */
X
#include    "estruct.h"
#include        "edef.h"
#ifndef NULL
#define NULL 0
#endif
X
extern CMDFUNC f_godotplus;
X
/* For the "operator" commands -- the following command is a motion, or
X *  the operator itself is repeated.  All operate on regions.
X */
operator(f,n,fn,str)
int (*fn)();
char *str;
{
X    int c;
X    int this1key;
X    int status;
X    CMDFUNC *cfp;            /* function to execute */
X    char tok[NSTRING];        /* command incoming */
X    LINE *ourmarkp;
X    int ourmarko;
X
X    doingopcmd = TRUE;
X
X        ourmarkp = curwp->w_dotp;
X        ourmarko = curwp->w_doto;
X
X    if (havemotion != NULL) {
X        cfp = havemotion;
X        havemotion = NULL;
X    } else {
X        mlwrite("%s operation pending...",str);
X        update(FALSE);
X
X        /* get the next command from the keyboard */
X        /* or a command line, as approp. */
X        if (clexec) {
X            macarg(tok);    /* get the next token */
X            if (!strcmp(tok,"lines"))
X                cfp = &f_godotplus;
X            else
X                cfp = engl2fnc(tok);
X        } else {
X            this1key = last1key;
X            c = kbd_seq();
X
X            /* allow second chance for entering counts */
X            if (f == FALSE) {
X                do_num_proc(&c,&f,&n);
X                do_rept_arg_proc(&c,&f,&n);
X            }
X
X            if (this1key == last1key)
X                cfp = &f_godotplus;
X            else
X                cfp = kcod2fnc(c);
X
X        }
X        mlerase();
X    }
X
X    if ((cfp->c_flags & MOTION) == 0) {
X        TTbeep();
X        return(ABORT);
X    }
X
X    /* motion is interpreted as affecting full lines */
X    if (cfp->c_flags & FL)
X        fulllineregions = TRUE;
X
X    /* and execute the motion */
X    status = execute(cfp, f, n);
X
X    if (status != TRUE ||
X       ( (ourmarkp == curwp->w_dotp && ourmarko == curwp->w_doto) &&
X            fulllineregions == FALSE) ) {
X        doingopcmd = FALSE;
X        fulllineregions = FALSE;
X        return status;
X    }
X
X    opcmd = 0;
X
X    curwp->w_mkp = ourmarkp;
X    curwp->w_mko = ourmarko;
X
X    /* we've successfully set up a region */
X    if (!fn) { /* be defensive */
X        mlwrite("BUG -- null func pointer in operator");
X        status = FALSE;
X    } else {
X        status = (fn)(f,n,NULL,NULL);
X    }
X
X    swapmark();
X
X    if (fulllineregions) {
X        fulllineregions = FALSE;
X        firstnonwhite(f,n);
X    }
X
X    doingopcmd = FALSE;
X    return status;
}
X
operdel(f,n)
{
X    extern int killregion();
X
X    opcmd = OPDEL;
X    return operator(f,n,killregion,"Delete");
}
X
operlinedel(f,n)
{
X    extern int killregion();
X
X    fulllineregions = TRUE;
X    opcmd = OPDEL;
X    return operator(f,n,killregion,"Delete of full lines");
}
X
chgreg(f,n)
{
X    killregion(f,n);
X    if (fulllineregions) {
X        backline(FALSE,1);
X        opendown(TRUE,1);
X    } else {
X        insert(f,n);
X    }
}
X
operchg(f,n)
{
X    int s;
X
X    opcmd = OPOTHER;
X    s = operator(f,n,chgreg,"Change");
X    swapmark();
X    return s;
}
X
operlinechg(f,n)
{
X    int s;
X
X    fulllineregions = TRUE;
X    opcmd = OPOTHER;
X    s = operator(f,n,chgreg,"Change of full lines");
X    swapmark();
X    return s;
}
X
operyank(f,n)
{
X    extern int yankregion();
X    opcmd = OPOTHER;
X    return operator(f,n,yankregion,"Yank");
}
X
operlineyank(f,n)
{
X    extern int yankregion();
X
X    fulllineregions = TRUE;
X    opcmd = OPOTHER;
X    return operator(f,n,yankregion,"Yank of full lines");
}
X
operflip(f,n)
{
X    extern int flipregion();
X
X    opcmd = OPOTHER;
X    return operator(f,n,flipregion,"Flip case");
}
X
operupper(f,n)
{
X    extern int upperregion();
X
X    opcmd = OPOTHER;
X    return operator(f,n,upperregion,"Upper case");
}
X
operlower(f,n)
{
X    extern int lowerregion();
X
X    opcmd = OPOTHER;
X    return operator(f,n,lowerregion,"Lower case");
}
X
X
operlshift(f,n)
{
X    extern int shiftlregion();
X
X    fulllineregions = TRUE;
X    opcmd = OPOTHER;
X    return operator(f,n,shiftlregion,"Left shift");
}
X
operrshift(f,n)
{
X    extern int shiftrregion();
X
X    fulllineregions = TRUE;
X    opcmd = OPOTHER;
X    return operator(f,n,shiftrregion,"Right shift");
}
X
operwrite(f,n)
{
X        register int    s;
X        static char fname[NFILEN];
X    extern int writeregion();
X
X    if (ukb != 0) {
X            if ((s=mlreply("Write to file: ", fname, NFILEN)) != TRUE)
X                    return s;
X        return kwrite(fname,TRUE);
X    } else {
X        opcmd = OPOTHER;
X        return operator(f,n,writeregion,"File write");
X    }
}
X
operformat(f,n)
{
X    extern int formatregion();
X
X    fulllineregions = TRUE;
X    opcmd = OPOTHER;
X    return operator(f,n,formatregion,"Format");
}
X
operfilter(f,n)
{
X    extern int filterregion();
X
X    fulllineregions = TRUE;
X    opcmd = OPOTHER;
X    return operator(f,n,filterregion,"Filter");
}
X
X
operprint(f,n)
{
X    extern int plineregion();
X
X    fulllineregions = TRUE;
X    opcmd = OPOTHER;
X    return operator(f,n,plineregion,"Line print");
}
X
operlist(f,n)
{
X    extern int llineregion();
X
X    fulllineregions = TRUE;
X    opcmd = OPOTHER;
X    return operator(f,n,llineregion,"Line list");
}
X
opersubst(f,n)
{
X    extern int substregion();
X
X    fulllineregions = TRUE;
X    opcmd = OPOTHER;
X    return operator(f,n,substregion,"Substitute");
}
SHAR_EOF
chmod 0444 opers.c ||
echo 'restore of opers.c failed'
Wc_c="`wc -c < 'opers.c'`"
test 4699 -eq "$Wc_c" ||
    echo 'opers.c: original size 4699, current size' "$Wc_c"
# ============= random.c ==============
echo 'x - extracting random.c (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'random.c' &&
/*
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
#include        <stdio.h>
#include    "estruct.h"
#include        "edef.h"
X
showgmodes(f,n)
{
X    return showm(TRUE);
}
X
showmodes(f,n)
{
X    return showm(FALSE);
}
X
showm(g)
{
X    char modes[100];
X    int gotmode = FALSE;
X    int i,b;
X
X    modes[0] = '\0';
X    for (i = 0; i < NUMMODES; i++) { /* add in the mode flags */
X        b = 1 << i;
X        if ((!g && (curbp->b_mode & b)) || (g && (gmode & b))) {
X            gotmode = TRUE;
X        } else {
X            strcat(modes, "no");
X        }
X        strcat(modes, modename[i]);
X        strcat(modes, " ");
X    }
X    if (gotmode == FALSE)
X        mlwrite("No modes set");
X    else
X        mlwrite(modes);
X    return TRUE;
}
X
/*
X * Set fill column to n.
X */
setfillcol(f, n)
{
X    if (f)
X            fillcol = n;
X    mlwrite("[Fill column is %d]",n);
X        return(TRUE);
}
X
/*
X * Display the current position of the cursor, lines and columns, in the file,
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 */
showcpos(f, n)
{
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 of %d, Col %d of %d, Char %D of %D (%d%%) char is 0x%x",
X        predlines+1, numlines, col+1, ecol,
X        predchars+1, numchars, ratio, curchar);
X        return TRUE;
}
X
showlength(f,n)
{
X        register LINE   *lp;        /* current line */
X        register int    numlines = 0;    /* # of lines in file */
X
X    /* starting at the beginning of the buffer */
X        lp = lforw(curbp->b_linep);
X        while (lp != curbp->b_linep) {
X        ++numlines;
X        lp = lforw(lp);
X        }
X    mlwrite("%d",numlines);
X    return TRUE;
}
X
#if ! SMALLER
getcline()    /* get the current line number */
{
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);
}
#endif
X
/*
X * Return current screen column.  Stop at first non-blank given TRUE argument.
X */
getccol(bflg)
int bflg;
{
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 (((curwp->w_bufp->b_mode&MDLIST) == 0) && c == '\t')
X                        col |= TABMASK;
X                else if (!isprint(c))
X                        ++col;
X                ++col;
X        }
X        return(col);
}
X
X
/*
X * Set current column.
X */
gotocol(f,n)
{
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    if ( n <= 0) n = 1;
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 >= n)
X            break;
X
X        /* advance one character */
X                c = lgetc(curwp->w_dotp, i);
X        if (((curwp->w_bufp->b_mode&MDLIST) == 0) && c == '\t')
X                        col |= TABMASK;
X                else if (!isprint(c))
X                        ++col;
X                ++col;
X        }
X
X    /* set us at the new position */
X    curwp->w_doto = i;
X
X    /* and tell whether we made it */
X    return(col >= n);
}
X
#if ! SMALLER
/*
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.
X * This always works within a line, so "WFEDIT" is good enough.
X */
twiddle(f, n)
{
X        register LINE   *dotp;
X        register int    doto;
X        register int    cl;
X        register int    cr;
X
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    copy_for_undo(dotp);
X        lputc(dotp, doto+0, cr);
X        lputc(dotp, doto+1, cl);
X        lchange(WFEDIT);
X        return (TRUE);
}
#endif
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.
X */
quote(f, n)
{
X        register int    s;
X        register int    c;
X
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
replacechar(f, n)
{
X        register int    s;
X        register int    c;
X
X    insertmode = TRUE;  /* need to fool the SPEC prefix code */
X        c = kbd_key();
X    insertmode = FALSE;
X
X        if (n < 0)
X                return (FALSE);
X        if (n == 0)
X                return (TRUE);
X    if (c == abortc)
X        return (FALSE);
X
X    ldelete((long)n,FALSE);
X    if (c == quotec) {
X        return(quote(f,n));
X    }
X    c = kcod2key(c);
X        if (c == '\n' || c == '\r') {
X                do {
X                        s = lnewline();
X                } while (s==TRUE && --n);
X                return (s);
X        } else if (isbackspace(c))
X        s = TRUE;
X    else
X        s = linsert(n, c);
X    if (s == TRUE)
X        s = backchar(FALSE,1);
X        return (s);
}
X
/*
X * Set tab size
X * for programmer convenience, tabs can only be 2, 4, 8, or 16
X * a lot of code uses masks, so this was easiest change from the old
X * hardcoded 8 column tabs
X */
settab(f, n)
{
X    register WINDOW *wp;
X    if (f && (n == 2 || n == 4 || n == 8 || n == 16)) {
X        TABVAL = n;
X        TABMASK = n-1;
X        for (wp = wheadp; wp != NULL; wp = wp->w_wndp)
X            wp->w_flag |= WFHARD;
X        refresh(FALSE,1);
X    } else if (f) {
X        mlwrite("Sorry, tabs must be 2, 4, 8, or 16");
X        TTbeep();
X        return FALSE;
X    }
X    mlwrite("Tabs are %d columns apart",TABVAL);
X    return TRUE;
}
X
/* insert a tab into the file */
tab(f, n)
{
X        return(linsert(1, '\t'));
}
X
#if    AEDIT
detab(f, n)        /* change tabs to spaces */
int f,n;    /* default flag and numeric repeat count */
{
X    register int inc;    /* increment to next line [sgn(n)] */
X
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, TABVAL - (curwp->w_doto & TABMASK));
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    curgoal = -1;
X    lchange(WFEDIT);    /* yes, we have made at least an edit */
X    return(TRUE);
}
X
entab(f, n)        /* change spaces to tabs where posible */
int f,n;    /* default flag and numeric repeat count */
{
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
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    curgoal = -1;
X    lchange(WFEDIT);    /* yes, we have made at least an edit */
X    return(TRUE);
}
X
#endif
X
/* trim trailing whitespace from a line.  leave dot at end of line */
trimline(f,n)
{
X    register int off, orig;
X    register LINE *lp;
X
X    lp = curwp->w_dotp;
X
X    off = llength(lp)-1;
X    orig = off;
X    while (off >= 0) {
X        if (!isspace(lgetc(lp,off)))
X            break;
X        off--;
X    }
X
X    if (off == orig)
X        return TRUE;
X
X    curwp->w_doto = off+1;
X
X    return ldelete(orig - off,FALSE);
}
X
X
#if NOCOUNT
/* open lines up before this one */
openup(f,n)
{
X    int backline();
X    int s;
X    gotobol(TRUE,1);
X    s = lnewline();
X    if (s != TRUE)
X        return(s);
X    s = backline(TRUE,1);
X    if (s != TRUE)
X        return(s);
X    return(opendown(TRUE,1));
}
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 * processors. They even handle the looping.
X * The function passed in is used to choose position before opening up.
X */
X
/* open lines up after this one */
opendown(f,n)
{
X        register int    i;
X        register int    s;
X
X    gotoeol(TRUE,1);
X        s = newline(TRUE,1);
X
X    curgoal = -1;
X
X    if (s != TRUE)
X        return (s);
X
X    return(ins(f,n));
}
#else
/* open lines up before this one */
openup(f,n)
{
X    int backline();
X    int s;
X    gotobol(TRUE,1);
X    s = lnewline();
X    if (s != TRUE)
X        return(s);
X    s = backline(TRUE,1);
X    if (s != TRUE)
X        return(s);
X    /* there's a bug here with counts.  I don't particularly care
X        right now.  */
X    return(opendown(f,n-1));
}
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 * processors. They even handle the looping.
X * The function passed in is used to choose position before opening up.
X */
X
/* open lines up after this one */
opendown(f,n)
{
X        register int    i;
X        register int    s;
X
X        if (n < 0)
X                return (FALSE);
X        if (n == 0) {
X                return (ins(f,n));
X    }
X
X        i = n;                                  /* Insert newlines.     */
X        do {
X        gotoeol(TRUE,1);
X                s = newline(TRUE,1);
X        } while (s==TRUE && --i);
X        if (s == TRUE)                          /* Then back up overtop */
X                s = backline(TRUE, n-1);             /* of them all.         */
X
X    curgoal = -1;
X
X    if (s != TRUE)
X        return (s);
X
X    return(ins(f,n));
}
#endif
X
X
/*
X * Go into insert mode.  I guess this isn't emacs anymore...
X */
insert(f, n)
{
X    return (ins(f,n));
}
X
insertbol(f, n)
{
X    firstnonwhite(f,n);
X    return (ins(f,n));
}
X
append(f, n)
{
X    if (curwp->w_doto != llength(curwp->w_dotp)) /* END OF LINE HACK */
X        forwchar(TRUE,1);
X    return (ins(f,n));
}
X
appendeol(f, n)
{
X    gotoeol(FALSE,0);
X    return (ins(f,n));
}
X
overwrite(f, n)
{
X    insertmode = OVERWRITE;
X    return ins(f,n);
}
X
/* grunt routine for insert mode */
ins(f,n)
{
X    register int status;
X    int (*execfunc)();        /* ptr to function to execute */
X    int    c;        /* command character */
X    extern int quote(), backspace(), tab(), newline(), nullproc();
#if BSD
X    extern int bktoshell();
#endif
X
X    if (insertmode == FALSE)
X    insertmode = INSERT;
X
X    /* get the next command from the keyboard */
X    while(1) {
X
X    update(FALSE);
X
X    f = FALSE;
X    n = 1;
X
X    c = kbd_key();
X
X    if (c == abortc ) {
X         /* an unfortunate Vi-ism that ensures one
X             can always type "ESC a" if you're not sure
X             you're in insert mode. */
X        if (curwp->w_doto != 0)
X            backchar(TRUE,1);
X        if (autoindented >= 0) {
X            trimline(FALSE,1);
X            autoindented = -1;
X        }
X        insertmode = FALSE;
X        return (TRUE);
X    }
X
X    execfunc = NULL;
X    if (c == quotec) {
X        execfunc = quote;
X    } else {
X            /*
X             * If a space was typed, fill column is defined, the
X         * argument is non- negative, wrap mode is enabled, and
X         * we are now past fill column, perform word wrap.
X             */
X            if (isspace(c) /* c == ' ' */ && (curwp->w_bufp->b_mode & MDWRAP) && fillcol > 0 &&
X            n >= 0 && getccol(FALSE) > fillcol )
X                wrapword();
X
X        if (isbackspace(c))
X            c = '\b';
X        switch(c) {
X            /* ^D and ^T are aliased to ^H and tab, for
X                users accustomed to "shiftwidth" */
X            case tocntrl('D'):
X            case '\b':
X                execfunc = (curwp->w_doto == 0) ?
X                        nullproc:backspace;
X                autoindented--;
X                break;
X            case tocntrl('T'):
X            case tocntrl('I'):
X                execfunc = tab;
X                autoindented = -1;
X                break;
X            case tocntrl('J'):
X            case tocntrl('M'):
X                execfunc = newline;
X                if (autoindented >= 0) {
X                    trimline(FALSE,1);
X                    autoindented = -1;
X                }
X                break;
#if UNIX && defined(SIGTSTP)    /* job control */
X            case tocntrl('Z'):
X                execfunc = bktoshell;
X                break;
#endif
X            case tocntrl('S'):
X            case tocntrl('Q'):
X                execfunc = nullproc;
X                break;
X        }
X    }
X
X    if (execfunc != NULL) {
X        status     = (*execfunc)(f, n);
X        if (status != TRUE) {
X            insertmode = FALSE;
X            return (status);
X        }
X        continue;
X    }
X
X
X    /* make it a real character again */
X    c = kcod2key(c);
X
X    /* if we are in overwrite mode, not at eol,
X       and next char is not a tab or we are at a tab stop,
X       delete a char forword            */
X    if (insertmode == OVERWRITE &&
X            curwp->w_doto < curwp->w_dotp->l_used &&
X            (lgetc(curwp->w_dotp, curwp->w_doto) != '\t' ||
X            (curwp->w_doto) % TABVAL == TABMASK)) {
X        autoindented = -1;
X        ldelete(1L, FALSE);
X    }
X
X    /* do the appropriate insertion */
X    if ((c == RBRACE) && ((curbp->b_mode & MDCMOD) != 0)) {
X            status = insbrace(n, c);
X    } else if (c == '#' && (curbp->b_mode & MDCMOD) != 0) {
X            status = inspound();
X    } else {
X        autoindented = -1;
X                status = linsert(n, c);
X    }
X
#if    CFENCE & !UNIX
X    /* check for CMODE fence matching */
X    if ((c == RBRACE || c == ')' || c == ']') &&
X            (curbp->b_mode & MDCMOD) != 0)
X        fmatch(c);
#endif
X
X    /* check auto-save mode */
X    if (curbp->b_mode & MDASAVE)
X        if (--gacount == 0) {
X            /* and save the file if needed */
X            upscreen(FALSE, 0);
X            filesave(FALSE, 0);
X            gacount = gasave;
X        }
X
X        if (status != TRUE) {
X        insertmode = FALSE;
X        return (status);
X    }
X    }
}
X
backspace()
{
X        register int    s;
X
X        if ((s=backchar(TRUE, 1)) == TRUE)
X                s = ldelete(1L, FALSE);
X        return (s);
}
X
/*
X * Insert a newline. If we are in CMODE, do automatic
X * indentation as specified.
X */
newline(f, n)
{
X    register int    s;
X
X    if (n < 0)
X        return (FALSE);
X
#if LATER    /* already done for autoindented != 0 in ins() */
X    if (curbp->b_mode & MDTRIM))
X        trimline(f,n);
#endif
X
X    /* if we are in C mode and this is a default <NL> */
X    if (n == 1 && (curbp->b_mode & (MDCMOD|MDAIND)) &&
X        curwp->w_dotp != curbp->b_linep)
X        return indented_newline(curbp->b_mode & MDCMOD);
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     * perform word wrap.
X         */
X        if ((curwp->w_bufp->b_mode & MDWRAP) && fillcol > 0 &&
X                        getccol(FALSE) > fillcol)
X            wrapword();
X
X    /* insert some lines */
X    while (n--) {
X        if ((s=lnewline()) != TRUE)
X            return (s);
X        curwp->w_flag |= WFINS;
X    }
X    return (TRUE);
}
X
/* insert a newline and indentation for C */
indented_newline(cmode)
{
X    register int indentwas;    /* indent to reproduce */
X    int bracef;    /* was there a brace at the end of line? */
X
X    indentwas = previndent(&bracef);
X    if (lnewline() == FALSE)
X        return FALSE;
X    if (cmode & bracef)
X        indentwas = (indentwas + TABVAL) & ~TABMASK;
X    if (doindent(indentwas) != TRUE)
X        return FALSE;
X    return TRUE;
}
X
/* get the indent of the last previous non-blank line.  also, if arg
X    is non-null, check if line ended in a brace */
int
previndent(bracefp)
int *bracefp;
{
X    int ind;
X
X    setmark();
X
X    if (backword(FALSE,1) == FALSE) {
X        if (bracefp) *bracefp = FALSE;
X        gomark();
X        return 0;
X    }
X    ind = indentlen(curwp->w_dotp);
X    if (bracefp)
X        *bracefp = (llength(curwp->w_dotp) > 0 &&
X            lgetc(curwp->w_dotp,llength(curwp->w_dotp)-1) == '{');
X
X    gomark();
X
X    return ind;
}
X
doindent(ind)
{
X    int i;
X    /* if no indent was asked for, we're done */
X    if (ind <= 0)
X        return TRUE;
X    autoindented = 0;
X        if ((i=ind/TABVAL)!=0) {
X        autoindented += i;
X        if (linsert(i, '\t') == FALSE)
X            return FALSE;
X    }
X    if ((i=ind%TABVAL) != 0) {
X        autoindented += i;
X        if (linsert(i,  ' ') == FALSE)
X            return FALSE;
X    }
X    if (!autoindented)
X        autoindented = -1;
X
X    return TRUE;
}
X
/* return the column indent of the specified line */
int
indentlen(lp)
LINE *lp;
{
X    register int ind, i, c;
X        ind = 0;
X        for (i=0; i<llength(lp); ++i) {
X                c = lgetc(lp, i);
X                if (!isspace(c))
X                        break;
X                if (c == '\t')
X                        ind |= TABMASK;
X                ++ind;
X        }
X        return ind;
}
X
insbrace(n, c)    /* insert a brace into the text here...we are in CMODE */
int n;    /* repeat count */
int c;    /* brace to insert (always { for now) */
{
X    register int ch;    /* last character before input */
X    register int i;
X    register int target;    /* column brace should go after */
X
#if ! CFENCE
X    /* wouldn't want to back up from here, but fences might take us
X        forward */
X    /* if we are at the beginning of the line, no go */
X    if (curwp->w_doto == 0)
X        return(linsert(n,c));
#endif
X
X    if (autoindented >= 0) {
X        trimline(FALSE,1);
X    }
X    else {
X        return linsert(n,c);
X    }
#if ! CFENCE /* no fences?  then put brace one tab in from previous line */
X    doindent((previndent(NULL)-1) & ~TABMASK);
#else /* line up brace with the line containing its match */
X    doindent(fmatchindent());
#endif
X    autoindented = -1;
X
X    /* and insert the required brace(s) */
X    return(linsert(n, c));
}
X
inspound()    /* insert a # into the text here...we are in CMODE */
{
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    if (autoindented > 0) {    /* must all be whitespace before us */
X        curwp->w_doto = 0;
X        ldelete(autoindented,FALSE);
X    }
X    autoindented = -1;
X
X    /* and insert the required pound */
X    return(linsert(1, '#'));
}
X
#if AEDIT
/*
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. Any argument is ignored.
X */
deblank(f, n)
{
X        register LINE   *lp1;
X        register LINE   *lp2;
X        long nld;
X
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
#endif
X
/* '~' is synonymous with 'M-~<space>' */
flipchar(f, n)
{
X    int s;
X    extern CMDFUNC f_forwchar;
X
X    if (curwp->w_doto != llength(curwp->w_dotp)) {
X        havemotion = &f_forwchar;
X        s = operflip(FALSE,1);
X        if (s == TRUE)
X            return forwchar(FALSE,1);
X    }
X    return FALSE;
}
X
/* 'x' is synonymous with 'd<space>' */
forwdelchar(f, n)
{
X    extern CMDFUNC f_forwchar, f_backchar;
X
X    if (curwp->w_doto != llength(curwp->w_dotp)) /* END OF LINE HACK */
X        havemotion = &f_forwchar;
X    else
X        havemotion = &f_backchar;
X    return(operdel(f,n));
}
X
/* 'X' is synonymous with 'd<backspace>' */
backdelchar(f, n)
{
X    extern CMDFUNC f_backchar, f_forwchar;
X
X    if (curwp->w_doto != 0) /* BEGINNING OF LINE HACK */
X        havemotion = &f_backchar;
X    else
X        havemotion = &f_forwchar;
X    return(operdel(f,n));
}
X
/* 'D' is synonymous with 'd$' */
deltoeol(f, n)
{
X    extern CMDFUNC f_gotoeol;
X
X    havemotion = &f_gotoeol;
X    return(operdel(FALSE,1));
}
X
/* 'C' is synonymous with 'c$' */
chgtoeol(f, n)
{
X    extern CMDFUNC f_gotoeol;
X
X        if (llength(curwp->w_dotp) == 0) {
X            return ins(f,n);
X        } else {
X        havemotion = &f_gotoeol;
X        return operchg(FALSE,1);
X    }
}
X
/* 'Y' is synonymous with 'yy' */
yankline(f, n)
{
X    extern CMDFUNC f_godotplus;
X    havemotion = &f_godotplus;
X    return(operyank(f,n));
}
X
/* 'S' is synonymous with 'cc' */
chgline(f, n)
{
X    extern CMDFUNC f_godotplus;
X    havemotion = &f_godotplus;
X    return(operchg(f,n));
}
X
/* 's' is synonymous with 'c<space>' */
chgchar(f, n)
{
X    extern CMDFUNC f_forwchar;
X
X    havemotion = &f_forwchar;
X    return(operchg(f,n));
}
X
setmode(f, n)    /* prompt and set an editor mode */
int f, n;    /* default and argument */
{
X    return(adjustmode(TRUE, FALSE));
}
X
delmode(f, n)    /* prompt and delete an editor mode */
int f, n;    /* default and argument */
{
X    return(adjustmode(FALSE, FALSE));
}
X
setgmode(f, n)    /* prompt and set a global editor mode */
int f, n;    /* default and argument */
{
X    return(adjustmode(TRUE, TRUE));
}
X
delgmode(f, n)    /* prompt and delete a global editor mode */
int f, n;    /* default and argument */
{
X    return(adjustmode(FALSE, TRUE));
}
X
X
adjustmode(kind, global)    /* change the editor mode status */
int kind;    /* true = set,        false = delete */
int global;    /* true = global flag,    false = current buffer flag */
{
X    register char *scan;        /* scanning pointer to convert prompt */
X    register int i;            /* loop index */
X    register status;        /* error return on input */
#if    COLOR
X    register int uflag;        /* was modename uppercase?    */
#endif
X    int no = 0;
X    int okind;
X    char prompt[50];    /* string to prompt user with */
X    static 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 lowercase */
X
X    scan = cbuf;
#if    COLOR
X    uflag = isupper(*scan);
#endif
X    while (*scan != 0) {
X        if (isupper(*scan))
X            *scan = tolower(*scan);
X        scan++;
X    }
X
X    if (!strcmp(cbuf,"all")) {
X        return showm(global);
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 */
#if    COLOR
X            if (uflag)
X                if (global)
X                    gfcolor = i;
X                else if (curwp)
X                    curwp->w_fcolor = i;
X            else
X                if (global)
X                    gbcolor = i;
X                else if (curwp)
X                    curwp->w_bcolor = i;
X
X            if (curwp)
X                curwp->w_flag |= WFCOLR;
#endif
X            mlerase();
X            return(TRUE);
X        }
X    }
X
X    /* test it against the modes we know */
X
X    if (strncmp(cbuf, "no", 2) == 0) {
X        okind = kind;
X        kind = !kind;
X        no = 2;
X    }
X    for (i=0; i < NUMMODES; i++) {
X        if (strcmp(&cbuf[no], modename[i]) == 0) {
X            /* finding a match, we process it */
X            if (kind == TRUE) {
X                if (global) {
X                    gmode |= (1 << i);
X                } else if (curbp) {
X                    curbp->b_mode |= (1 << i);
X                }
X            } else {
X                if (global) {
X                    gmode &= ~(1 << i);
X                } else if (curbp) {
X                    curbp->b_mode &= ~(1 << i);
X                }
X            }
X            /* display new mode line */
X            if (global == 0 && curbp)
X                upmode();
X            mlerase();    /* erase the junk */
X            return(TRUE);
X        }
X    }
X
X    /* test it against other modes... */
X    /* these are global modes that don't inherit to windows */
X    for (i=0; i < NUMOTHERMODES; i++) {
X        if (strcmp(&cbuf[no], othermodes[i]) == 0) {
X            /* finding a match, we process it */
X            if (kind == TRUE)
X                othmode |= (1 << i);
X            else
X                othmode &= ~(1 << i);
X            mlerase();    /* erase the junk */
X            return(TRUE);
X        }
X    }
X    kind = okind;
X
X    /* test it against valued  modes... */
X    /* these are global modes that have values */
X    for (i=0; i < NUMVALUEMODES; i++) {
X        if (strcmp(cbuf, valuemodes[i]) == 0) {
X            int nval;
X            char *cp;
X            char valbuf[NPAT];
X
X            valbuf[0] = '\0';
X            status = mlreply("New value: ", valbuf, NPAT - 1);
X            if (status != TRUE)
X                return status;
X            /* finding a match, we process it */
X            nval = 0;
X            cp = valbuf;
X            while (isdigit(*cp))
X                nval = (nval * 10) + (*cp++ - '0');
X            switch(i) {
X            case VAL_TAB:
X                settab(TRUE,nval);
X                break;
X            case VAL_FILL:
X                setfillcol(TRUE,nval);
X                break;
X            }
X            mlerase();    /* erase the junk */
X            return(TRUE);
X        }
X    }
X
X    mlwrite("No such mode!");
X    return(FALSE);
}
X
X
/* Quiet adjust mode, no message line echo.
X * Expects a string to follow: SGover to set global overtype.
X * Prefixes are SG, RG, SL, RL.  Text will be taken until a newline.
X */
#if    NeWS
newsadjustmode()    /* change the editor mode status */
{
X    register char *scan;        /* scanning pointer to convert prompt */
X    register int i;            /* loop index */
#if    COLOR
X    register int uflag;        /* was modename uppercase?    */
#endif
X    char cbuf[NPAT];        /* buffer to recieve mode name into */
X    char ch ;
X    int kind, global ;
X
X    /* get the mode name and switches */
X    kind = ('S' == tgetc()) ;
X    global = ('G' == tgetc()) ;
X    for (i=0; i<NPAT; i++) {
X        if ( '\n' == (ch=tgetc()) ) {
X            cbuf[i] = NULL ;
X            break ;
X        }
X        cbuf[i] = ch ;
X    }
X
X    /* make it uppercase */
X    scan = cbuf;
#if    COLOR
X    uflag = isupper(*scan);
#endif
X    while (*scan != 0) {
X        if (islower(*scan))
X            *scan = toupper(*scan);
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 */
#if    COLOR
X            if (uflag)
X                if (global)
X                    gfcolor = i;
X                else if (curwp)
X                    curwp->w_fcolor = i;
X            else
X                if (global)
X                    gbcolor = i;
X                else if (curwp)
X                    curwp->w_bcolor = i;
X
X            if (curwp)
X                curwp->w_flag |= WFCOLR;
#endif
X            return(TRUE);
X        }
X    }
X
X    /* test it against the modes we know */
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 if (curbp)
X                    curbp->b_mode |= (1 << i);
X            else
X                if (global)
X                    gmode &= ~(1 << i);
X                else if (curbp)
X                    curbp->b_mode &= ~(1 << i);
X            /* display new mode line */
X            if (global == 0 && curbp)
X                upmode();
X            return(TRUE);
X        }
X    }
X    return(FALSE);
}
#endif
X
X
/*    This function simply clears the message line,
X        mainly for macro usage            */
X
clrmes(f, n)
X
int f, n;    /* arguments ignored */
X
{
X    mlforce("");
X    return(TRUE);
}
X
#if ! SMALLER
X
/*    This function writes a string on the message line
X        mainly for macro usage            */
X
writemsg(f, n)
int f, n;    /* arguments ignored */
{
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    buf[0] = 0;
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);
}
#endif
X
#if    CFENCE
/*    the cursor is moved to a matching fence    */
X
getfence(f, n, ch)
int f, n;    /* not used */
int ch;    /* fence type to match against */
{
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 int ofence;    /* open fence */
X    register int c;    /* current character in scan */
X    int s;
X
X    /* save the original cursor position */
X    oldlp = curwp->w_dotp;
X    oldoff = curwp->w_doto;
X
X    if (!ch) {    /* ch may have been passed, if being used internally */
X        /* get the current character */
X        if (oldoff == llength(oldlp))
X            ch = '\n';
X        else
X            ch = lgetc(oldlp, oldoff);
X    }
X
X    /* setup proper matching fence */
X    switch (ch) {
X        case '(': ofence = ')'; sdir = FORWARD; break;
X        case LBRACE: ofence = RBRACE; sdir = FORWARD; break;
X        case '[': ofence = ']'; sdir = FORWARD; break;
X        case ')': ofence = '('; sdir = REVERSE; break;
X        case RBRACE: ofence = LBRACE; sdir = REVERSE; break;
X        case ']': ofence = '['; sdir = REVERSE; break;
X        default: TTbeep(); return(FALSE);
X    }
X
X    /* ops are inclusive of the endpoint */
X    if (doingopcmd && sdir == REVERSE) {
X        forwchar(TRUE,1);
X        setmark();
X        backchar(TRUE,1);
X    }
X
X    /* set up for scan */
X    if (sdir == REVERSE)
X        backchar(FALSE, 1);
X    else
X        forwchar(FALSE, 1);
X
X    count = 1;
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
X        if (c == ch)
X            ++count;
X        else if (c == ofence)
X            --count;
X
X        if (sdir == FORWARD)
X            s = forwchar(FALSE, 1);
X        else
X            s = backchar(FALSE, 1);
X
X        if (s == FALSE)
X            break;
X
X        if (interrupted) {
X            count = 1;
X            break;
X        }
X    }
X
X    /* if count is zero, we have a match, move the sucker */
X    if (count == 0) {
X        if (sdir == FORWARD) {
X            if (!doingopcmd)
X                backchar(FALSE, 1);
X        } else {
X            forwchar(FALSE, 1);
X        }
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
/* get the indent of the line containing the matching brace. */
int
fmatchindent()
{
X    int ind;
X
X    setmark();
X
X    if (getfence(FALSE,1,RBRACE) == FALSE) {
X        gomark();
X        return previndent(NULL);
X    }
X
X    ind = indentlen(curwp->w_dotp);
X
X    gomark();
X
X    return ind;
}
X
X
#if ! UNIX    /* the code as written is useless, since it busy-waits... */
X
/*    Close fences are matched against their partners, and if
X    on screen the cursor briefly lights there        */
fmatch(ch)
char ch;    /* fence type to match against */
{
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 == RBRACE)
X        opench = LBRACE;
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);
}
#endif /* ! UNIX */
X
#endif /* CFENCE */
X
#if ! SMALLER
istring(f, n)    /* ask for and insert a string into the current
X           buffer at the current point */
int f, n;    /* ignored arguments */
{
X    register char *tp;    /* pointer into string to add */
X    register int status;    /* status return code */
X    static char tstring[NPAT+1];    /* string to add */
X
X    /* ask for string to insert */
X    status = mlreply("String to insert: ", tstring, NPAT);
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 == '\n')
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);
}
#endif
SHAR_EOF
chmod 0444 random.c ||
echo 'restore of random.c failed'
Wc_c="`wc -c < 'random.c'`"
test 34147 -eq "$Wc_c" ||
    echo 'random.c: original size 34147, current size' "$Wc_c"
# ============= readme.news ==============
echo 'x - extracting readme.news (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'readme.news' &&
Here follows the NeWS README that was with the version I got....  -pgf
X
NeWS Distributed EMACS
X
Roger Ove
X
Introduction
X
This distributed version of MicroEMACS is designed primarily for
operation on machines where excessive keyboard interrupts are to be
avoided, such as Cray supercomputers running UNICOS. It reduces the
interrupt load to the level of a line editor, while providing some
additional features over typical resident full-screen editors. It will
function equally well on other unix machines, and as it also optimizes
screen updates and reduces network packets it may be of use in some low
bandwidth situations.
X
MicroEMACS was originally written by Dave Conroy, and includes
contributions from many people.  Most notable among the contributors is
Daniel Lawrence, who also maintains the source.  This noncommercial
implementation is derived from Lawrence's v3.9, to which he holds the
copyright.
X
Operation
X
Some of the features of this distributed version include:
X
X    Efficient i/o handling while remaining completely seamless.
X
X    Mouse support (for cutting/pasting text and cursor movement).
X
X    Menu support for most of the features of emacs.
X
X    Usable on any workstation running the NeWS server without the
X    need for the user to obtain the front end module.  The front end
X    is automatically downloaded to the workstation when the editor is
X    invoked.
X
X    All features of MicroEMACS 3.9 are supported, including multiple
SHAR_EOF
true || echo 'restore of readme.news failed'
echo 'End of Vile part 11'
echo 'File readme.news is continued in part 12'
echo 12 > _shar_seq_.tmp
exit 0
--
        paul fox, [e-mail], [phone]
        Cayman Systems, 26 Landsdowne St., Cambridge, MA 02139