Usenet 1994 October/usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso/misc/volume1/8711/10

Text File | 1987-11-17 | 35KB | 1,447 lines

Article 77 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 1 of 16)
Message-ID: <[e-mail]>
Date: 14 Nov 87 21:05:32 GMT
Sender: [e-mail]
Lines: 1432
Approved: [e-mail]
X-Archive: comp.sources.misc/8711/10

# This is a shar archive.
# Remove everything above this line.
# Run the file through sh, not csh.
# (type `sh mes.1')
# If you do not see the message
#    `mes.1 completed!'
# then the file was incomplete.
echo extracting - ansi.c
sed 's/^X//' > ansi.c << 'FRIDAY_NIGHT'
X/*
X * The routines in this file provide support for ANSI style terminals
X * over a serial line. The serial I/O services are provided by routines in
X * "termio.c". It compiles into nothing if not an ANSI device.
X */
X
X#define    termdef    1            /* don't define "term" external */
X
X#include        <stdio.h>
X#include    "estruct.h"
X#include        "edef.h"
X
X#if     ANSI
X
X#if    AMIGA
X#define NROW    23                      /* Screen size.                 */
X#define NCOL    77                      /* Edit if you want to.         */
X#else
X#define NROW    25                      /* Screen size.                 */
X#define NCOL    80                      /* Edit if you want to.         */
X#endif
X#define    NPAUSE    100            /* # times thru update to pause */
X#define    MARGIN    8            /* size of minimim margin and    */
X#define    SCRSIZ    64            /* scroll size for extended lines */
X#define BEL     0x07                    /* BEL character.               */
X#define ESC     0x1B                    /* ESC character.               */
X
Xextern  int     ttopen();               /* Forward references.          */
Xextern  int     ttgetc();
Xextern  int     ttputc();
Xextern  int     ttflush();
Xextern  int     ttclose();
Xextern  int     ansimove();
Xextern  int     ansieeol();
Xextern  int     ansieeop();
Xextern  int     ansibeep();
Xextern  int     ansiopen();
Xextern    int    ansirev();
Xextern    int    ansiclose();
Xextern    int    ansikopen();
Xextern    int    ansikclose();
Xextern    int    ansicres();
X
X#if    COLOR
Xextern    int    ansifcol();
Xextern    int    ansibcol();
X
Xint    cfcolor = -1;        /* current forground color */
Xint    cbcolor = -1;        /* current background color */
X
X#if    AMIGA
X/* apperently the AMIGA does not follow the ANSI standards as
X   regards to colors....maybe because of the default pallette
X   settings?
X*/
X
Xint coltran[8] = {2, 3, 5, 7, 0, 4, 6, 1};    /* color translation table */
X#endif
X#endif
X
X/*
X * Standard terminal interface dispatch table. Most of the fields point into
X * "termio" code.
X */
XTERM    term    = {
X    NROW-1,
X        NROW-1,
X        NCOL,
X        NCOL,
X    MARGIN,
X    SCRSIZ,
X    NPAUSE,
X        ansiopen,
X        ansiclose,
X    ansikopen,
X    ansikclose,
X        ttgetc,
X        ttputc,
X        ttflush,
X        ansimove,
X        ansieeol,
X        ansieeop,
X        ansibeep,
X    ansirev,
X    ansicres
X#if    COLOR
X    , ansifcol,
X    ansibcol
X#endif
X};
X
X#if    COLOR
Xansifcol(color)        /* set the current output color */
X
Xint color;    /* color to set */
X
X{
X    if (color == cfcolor)
X        return;
X    ttputc(ESC);
X    ttputc('[');
X#if    AMIGA
X    ansiparm(coltran[color]+30);
X#else
X    ansiparm(color+30);
X#endif
X    ttputc('m');
X    cfcolor = color;
X}
X
Xansibcol(color)        /* set the current background color */
X
Xint color;    /* color to set */
X
X{
X    if (color == cbcolor)
X        return;
X    ttputc(ESC);
X    ttputc('[');
X#if    AMIGA
X    ansiparm(coltran[color]+40);
X#else
X    ansiparm(color+40);
X#endif
X    ttputc('m');
X        cbcolor = color;
X}
X#endif
X
Xansimove(row, col)
X{
X        ttputc(ESC);
X        ttputc('[');
X        ansiparm(row+1);
X        ttputc(';');
X        ansiparm(col+1);
X        ttputc('H');
X}
X
Xansieeol()
X{
X        ttputc(ESC);
X        ttputc('[');
X        ttputc('K');
X}
X
Xansieeop()
X{
X#if    COLOR
X    ansifcol(gfcolor);
X    ansibcol(gbcolor);
X#endif
X        ttputc(ESC);
X        ttputc('[');
X        ttputc('J');
X}
X
Xansirev(state)        /* change reverse video state */
X
Xint state;    /* TRUE = reverse, FALSE = normal */
X
X{
X#if    COLOR
X    int ftmp, btmp;        /* temporaries for colors */
X#endif
X
X    ttputc(ESC);
X    ttputc('[');
X    ttputc(state ? '7': '0');
X    ttputc('m');
X#if    COLOR
X    if (state == FALSE) {
X        ftmp = cfcolor;
X        btmp = cbcolor;
X        cfcolor = -1;
X        cbcolor = -1;
X        ansifcol(ftmp);
X        ansibcol(btmp);
X    }
X#endif
X}
X
Xansicres()    /* change screen resolution */
X
X{
X    return(TRUE);
X}
X
Xspal(dummy)        /* change pallette settings */
X
X{
X    /* none for now */
X}
X
Xansibeep()
X{
X        ttputc(BEL);
X        ttflush();
X}
X
Xansiparm(n)
Xregister int    n;
X{
X        register int q,r;
X
X        q = n/10;
X        if (q != 0) {
X        r = q/10;
X        if (r != 0) {
X            ttputc((r%10)+'0');
X        }
X        ttputc((q%10) + '0');
X        }
X        ttputc((n%10) + '0');
X}
X
Xansiopen()
X{
X#if     V7 | USG | BSD
X        register char *cp;
X        char *getenv();
X
X        if ((cp = getenv("TERM")) == NULL) {
X                puts("Shell variable TERM not defined!");
X                exit(1);
X        }
X        if (strcmp(cp, "vt100") != 0) {
X                puts("Terminal type not 'vt100'!");
X                exit(1);
X        }
X#endif
X    strcpy(sres, "NORMAL");
X    revexist = TRUE;
X        ttopen();
X}
X
Xansiclose()
X
X{
X#if    COLOR
X    ansifcol(7);
X    ansibcol(0);
X#endif
X    ttclose();
X}
X
Xansikopen()    /* open the keyboard (a noop here) */
X
X{
X}
X
Xansikclose()    /* close the keyboard (a noop here) */
X
X{
X}
X
X#if    FLABEL
Xfnclabel(f, n)        /* label a function key */
X
Xint f,n;    /* default flag, numeric argument [unused] */
X
X{
X    /* on machines with no function keys...don't bother */
X    return(TRUE);
X}
X#endif
X#else
Xansihello()
X{
X}
X#endif
FRIDAY_NIGHT
echo extracting - basic.c
sed 's/^X//' > basic.c << 'FRIDAY_NIGHT'
X/*
X * The routines in this file move the cursor around on the screen. They
X * compute a new value for the cursor, then adjust ".". The display code
X * always updates the cursor location, so only moves between lines, or
X * functions that adjust the top line in the window and invalidate the
X * framing, are hard.
X */
X#include        <stdio.h>
X#include    "estruct.h"
X#include        "edef.h"
X
X/*
X * Move the cursor to the
X * beginning of the current line.
X * Trivial.
X */
Xgotobol(f, n)
X{
X        curwp->w_doto  = 0;
X        return (TRUE);
X}
X
X/*
X * Move the cursor backwards by "n" characters. If "n" is less than zero call
X * "forwchar" to actually do the move. Otherwise compute the new cursor
X * location. Error if you try and move out of the buffer. Set the flag if the
X * line pointer for dot changes.
X */
Xbackchar(f, n)
Xregister int    n;
X{
X        register LINE   *lp;
X
X        if (n < 0)
X                return (forwchar(f, -n));
X        while (n--) {
X                if (curwp->w_doto == 0) {
X                        if ((lp=lback(curwp->w_dotp)) == curbp->b_linep)
X                                return (FALSE);
X                        curwp->w_dotp  = lp;
X                        curwp->w_doto  = llength(lp);
X                        curwp->w_flag |= WFMOVE;
X                } else
X                        curwp->w_doto--;
X        }
X        return (TRUE);
X}
X
X/*
X * Move the cursor to the end of the current line. Trivial. No errors.
X */
Xgotoeol(f, n)
X{
X        curwp->w_doto  = llength(curwp->w_dotp);
X        return (TRUE);
X}
X
X/*
X * Move the cursor forwards by "n" characters. If "n" is less than zero call
X * "backchar" to actually do the move. Otherwise compute the new cursor
X * location, and move ".". Error if you try and move off the end of the
X * buffer. Set the flag if the line pointer for dot changes.
X */
Xforwchar(f, n)
Xregister int    n;
X{
X        if (n < 0)
X                return (backchar(f, -n));
X        while (n--) {
X                if (curwp->w_doto == llength(curwp->w_dotp)) {
X                        if (curwp->w_dotp == curbp->b_linep)
X                                return (FALSE);
X                        curwp->w_dotp  = lforw(curwp->w_dotp);
X                        curwp->w_doto  = 0;
X                        curwp->w_flag |= WFMOVE;
X                } else
X                        curwp->w_doto++;
X        }
X        return (TRUE);
X}
X
Xgotoline(f, n)        /* move to a particular line.
X               argument (n) must be a positive integer for
X               this to actually do anything        */
X
X{
X    register int status;    /* status return */
X    char arg[NSTRING];    /* buffer to hold argument */
X
X    /* get an argument if one doesnt exist */
X    if (f == FALSE) {
X        if ((status = mlreply("Line to GOTO: ", arg, NSTRING)) != TRUE) {
X            mlwrite("[Aborted]");
X            return(status);
X        }
X        n = atoi(arg);
X    }
X
X    if (n < 1)        /* if a bogus argument...then leave */
X        return(FALSE);
X
X    /* first, we go to the start of the buffer */
X        curwp->w_dotp  = lforw(curbp->b_linep);
X        curwp->w_doto  = 0;
X    return(forwline(f, n-1));
X}
X
X/*
X * Goto the beginning of the buffer. Massive adjustment of dot. This is
X * considered to be hard motion; it really isn't if the original value of dot
X * is the same as the new value of dot. Normally bound to "M-<".
X */
Xgotobob(f, n)
X{
X        curwp->w_dotp  = lforw(curbp->b_linep);
X        curwp->w_doto  = 0;
X        curwp->w_flag |= WFHARD;
X        return (TRUE);
X}
X
X/*
X * Move to the end of the buffer. Dot is always put at the end of the file
X * (ZJ). The standard screen code does most of the hard parts of update.
X * Bound to "M->".
X */
Xgotoeob(f, n)
X{
X        curwp->w_dotp  = curbp->b_linep;
X        curwp->w_doto  = 0;
X        curwp->w_flag |= WFHARD;
X        return (TRUE);
X}
X
X/*
X * Move forward by full lines. If the number of lines to move is less than
X * zero, call the backward line function to actually do it. The last command
X * controls how the goal column is set. Bound to "C-N". No errors are
X * possible.
X */
Xforwline(f, n)
X{
X        register LINE   *dlp;
X
X        if (n < 0)
X                return (backline(f, -n));
X
X    /* if we are on the last line as we start....fail the command */
X    if (curwp->w_dotp == curbp->b_linep)
X        return(FALSE);
X
X    /* if the last command was not note a line move,
X       reset the goal column */
X        if ((lastflag&CFCPCN) == 0)
X                curgoal = getccol(FALSE);
X
X    /* flag this command as a line move */
X        thisflag |= CFCPCN;
X
X    /* and move the point down */
X        dlp = curwp->w_dotp;
X        while (n-- && dlp!=curbp->b_linep)
X                dlp = lforw(dlp);
X
X    /* reseting the current position */
X        curwp->w_dotp  = dlp;
X        curwp->w_doto  = getgoal(dlp);
X        curwp->w_flag |= WFMOVE;
X        return (TRUE);
X}
X
X/*
X * This function is like "forwline", but goes backwards. The scheme is exactly
X * the same. Check for arguments that are less than zero and call your
X * alternate. Figure out the new line and call "movedot" to perform the
X * motion. No errors are possible. Bound to "C-P".
X */
Xbackline(f, n)
X{
X        register LINE   *dlp;
X
X        if (n < 0)
X                return (forwline(f, -n));
X
X
X    /* if we are on the last line as we start....fail the command */
X    if (lback(curwp->w_dotp) == curbp->b_linep)
X        return(FALSE);
X
X    /* if the last command was not note a line move,
X       reset the goal column */
X        if ((lastflag&CFCPCN) == 0)
X                curgoal = getccol(FALSE);
X
X    /* flag this command as a line move */
X        thisflag |= CFCPCN;
X
X    /* and move the point up */
X        dlp = curwp->w_dotp;
X        while (n-- && lback(dlp)!=curbp->b_linep)
X                dlp = lback(dlp);
X
X    /* reseting the current position */
X        curwp->w_dotp  = dlp;
X        curwp->w_doto  = getgoal(dlp);
X        curwp->w_flag |= WFMOVE;
X        return (TRUE);
X}
X
X#if    WORDPRO
Xgotobop(f, n)    /* go back to the beginning of the current paragraph
X           here we look for a <NL><NL> or <NL><TAB> or <NL><SPACE>
X           combination to delimit the beginning of a paragraph    */
X
Xint f, n;    /* default Flag & Numeric argument */
X
X{
X    register int suc;    /* success of last backchar */
X
X    if (n < 0)    /* the other way...*/
X        return(gotoeop(f, -n));
X
X    while (n-- > 0) {    /* for each one asked for */
X
X        /* first scan back until we are in a word */
X        suc = backchar(FALSE, 1);
X        while (!inword() && suc)
X            suc = backchar(FALSE, 1);
X        curwp->w_doto = 0;    /* and go to the B-O-Line */
X
X        /* and scan back until we hit a <NL><NL> or <NL><TAB>
X           or a <NL><SPACE>                    */
X        while (lback(curwp->w_dotp) != curbp->b_linep)
X            if (llength(curwp->w_dotp) != 0 &&
X                lgetc(curwp->w_dotp, curwp->w_doto) != TAB &&
X                lgetc(curwp->w_dotp, curwp->w_doto) != ' ')
X                curwp->w_dotp = lback(curwp->w_dotp);
X            else
X                break;
X
X        /* and then forward until we are in a word */
X        suc = forwchar(FALSE, 1);
X        while (suc && !inword())
X            suc = forwchar(FALSE, 1);
X    }
X    curwp->w_flag |= WFMOVE;    /* force screen update */
X    return(TRUE);
X}
X
Xgotoeop(f, n)    /* go forword to the end of the current paragraph
X           here we look for a <NL><NL> or <NL><TAB> or <NL><SPACE>
X           combination to delimit the beginning of a paragraph    */
X
Xint f, n;    /* default Flag & Numeric argument */
X
X{
X    register int suc;    /* success of last backchar */
X
X    if (n < 0)    /* the other way...*/
X        return(gotobop(f, -n));
X
X    while (n-- > 0) {    /* for each one asked for */
X
X        /* first scan forward until we are in a word */
X        suc = forwchar(FALSE, 1);
X        while (!inword() && suc)
X            suc = forwchar(FALSE, 1);
X        curwp->w_doto = 0;    /* and go to the B-O-Line */
X        if (suc)    /* of next line if not at EOF */
X            curwp->w_dotp = lforw(curwp->w_dotp);
X
X        /* and scan forword until we hit a <NL><NL> or <NL><TAB>
X           or a <NL><SPACE>                    */
X        while (curwp->w_dotp != curbp->b_linep) {
X            if (llength(curwp->w_dotp) != 0 &&
X                lgetc(curwp->w_dotp, curwp->w_doto) != TAB &&
X                lgetc(curwp->w_dotp, curwp->w_doto) != ' ')
X                curwp->w_dotp = lforw(curwp->w_dotp);
X            else
X                break;
X        }
X
X        /* and then backward until we are in a word */
X        suc = backchar(FALSE, 1);
X        while (suc && !inword()) {
X            suc = backchar(FALSE, 1);
X        }
X        curwp->w_doto = llength(curwp->w_dotp);    /* and to the EOL */
X    }
X    curwp->w_flag |= WFMOVE;    /* force screen update */
X    return(TRUE);
X}
X#endif
X
X/*
X * This routine, given a pointer to a LINE, and the current cursor goal
X * column, return the best choice for the offset. The offset is returned.
X * Used by "C-N" and "C-P".
X */
Xgetgoal(dlp)
Xregister LINE   *dlp;
X{
X        register int    c;
X        register int    col;
X        register int    newcol;
X        register int    dbo;
X
X        col = 0;
X        dbo = 0;
X        while (dbo != llength(dlp)) {
X                c = lgetc(dlp, dbo);
X                newcol = col;
X                if (c == '\t')
X                        newcol |= 0x07;
X                else if (c<0x20 || c==0x7F)
X                        ++newcol;
X                ++newcol;
X                if (newcol > curgoal)
X                        break;
X                col = newcol;
X                ++dbo;
X        }
X        return (dbo);
X}
X
X/*
X * Scroll forward by a specified number of lines, or by a full page if no
X * argument. Bound to "C-V". The "2" in the arithmetic on the window size is
X * the overlap; this value is the default overlap value in ITS EMACS. Because
X * this zaps the top line in the display window, we have to do a hard update.
X */
Xforwpage(f, n)
Xregister int    n;
X{
X        register LINE   *lp;
X
X        if (f == FALSE) {
X                n = curwp->w_ntrows - 2;        /* Default scroll.      */
X                if (n <= 0)                     /* Forget the overlap   */
X                        n = 1;                  /* if tiny window.      */
X        } else if (n < 0)
X                return (backpage(f, -n));
X#if     CVMVAS
X        else                                    /* Convert from pages   */
X                n *= curwp->w_ntrows;           /* to lines.            */
X#endif
X        lp = curwp->w_linep;
X        while (n-- && lp!=curbp->b_linep)
X                lp = lforw(lp);
X        curwp->w_linep = lp;
X        curwp->w_dotp  = lp;
X        curwp->w_doto  = 0;
X        curwp->w_flag |= WFHARD;
X        return (TRUE);
X}
X
X/*
X * This command is like "forwpage", but it goes backwards. The "2", like
X * above, is the overlap between the two windows. The value is from the ITS
X * EMACS manual. Bound to "M-V". We do a hard update for exactly the same
X * reason.
X */
Xbackpage(f, n)
Xregister int    n;
X{
X        register LINE   *lp;
X
X        if (f == FALSE) {
X                n = curwp->w_ntrows - 2;        /* Default scroll.      */
X                if (n <= 0)                     /* Don't blow up if the */
X                        n = 1;                  /* window is tiny.      */
X        } else if (n < 0)
X                return (forwpage(f, -n));
X#if     CVMVAS
X        else                                    /* Convert from pages   */
X                n *= curwp->w_ntrows;           /* to lines.            */
X#endif
X        lp = curwp->w_linep;
X        while (n-- && lback(lp)!=curbp->b_linep)
X                lp = lback(lp);
X        curwp->w_linep = lp;
X        curwp->w_dotp  = lp;
X        curwp->w_doto  = 0;
X        curwp->w_flag |= WFHARD;
X        return (TRUE);
X}
X
X/*
X * Set the mark in the current window to the value of "." in the window. No
X * errors are possible. Bound to "M-.".
X */
Xsetmark(f, n)
X{
X        curwp->w_markp = curwp->w_dotp;
X        curwp->w_marko = curwp->w_doto;
X        mlwrite("[Mark set]");
X        return (TRUE);
X}
X
X/*
X * Swap the values of "." and "mark" in the current window. This is pretty
X * easy, bacause all of the hard work gets done by the standard routine
X * that moves the mark about. The only possible error is "no mark". Bound to
X * "C-X C-X".
X */
Xswapmark(f, n)
X{
X        register LINE   *odotp;
X        register int    odoto;
X
X        if (curwp->w_markp == NULL) {
X                mlwrite("No mark in this window");
X                return (FALSE);
X        }
X        odotp = curwp->w_dotp;
X        odoto = curwp->w_doto;
X        curwp->w_dotp  = curwp->w_markp;
X        curwp->w_doto  = curwp->w_marko;
X        curwp->w_markp = odotp;
X        curwp->w_marko = odoto;
X        curwp->w_flag |= WFMOVE;
X        return (TRUE);
X}
FRIDAY_NIGHT
echo extracting - bind.c
sed 's/^X//' > bind.c << 'FRIDAY_NIGHT'
X/*    This file is for functions having to do with key bindings,
X    descriptions, help commands and startup file.
X
X    written 11-feb-86 by Daniel Lawrence
X                                */
X
X#include    <stdio.h>
X#include    "estruct.h"
X#include    "edef.h"
X#include    "epath.h"
X
Xextern int meta(), cex(), unarg(), ctrlg(); /* dummy prefix binding functions */
X
Xhelp(f, n)    /* give me some help!!!!
X           bring up a fake buffer and read the help file
X           into it with view mode            */
X{
X    register WINDOW *wp;    /* scaning pointer to windows */
X    register BUFFER *bp;    /* buffer pointer to help */
X    char *fname;        /* ptr to file returned by flook() */
X
X    /* first check if we are already here */
X    bp = bfind("emacs.hlp", FALSE, BFINVS);
X
X    if (bp == NULL) {
X        fname = flook(pathname[1], FALSE);
X        if (fname == NULL) {
X            mlwrite("[Help file is not online]");
X            return(FALSE);
X        }
X    }
X
X    /* split the current window to make room for the help stuff */
X    if (splitwind(FALSE, 1) == FALSE)
X            return(FALSE);
X
X    if (bp == NULL) {
X        /* and read the stuff in */
X        if (getfile(fname, FALSE) == FALSE)
X            return(FALSE);
X    } else
X        swbuffer(bp);
X
X    /* make this window in VIEW mode, update all mode lines */
X    curwp->w_bufp->b_mode |= MDVIEW;
X    curwp->w_bufp->b_flag |= BFINVS;
X    wp = wheadp;
X    while (wp != NULL) {
X        wp->w_flag |= WFMODE;
X        wp = wp->w_wndp;
X    }
X    return(TRUE);
X}
X
Xdeskey(f, n)    /* describe the command for a certain key */
X
X{
X    register int c;        /* key to describe */
X    register char *ptr;    /* string pointer to scan output strings */
X    char outseq[NSTRING];    /* output buffer for command sequence */
X    int (*getbind())();
X
X    /* prompt the user to type us a key to describe */
X    mlwrite(": describe-key ");
X
X    /* get the command sequence to describe
X       change it to something we can print as well */
X    cmdstr(c = getckey(FALSE), &outseq[0]);
X
X    /* and dump it out */
X    ostring(outseq);
X    ostring(" ");
X
X    /* find the right ->function */
X    if ((ptr = getfname(getbind(c))) == NULL)
X        ptr = "Not Bound";
X
X    /* output the command sequence */
X    ostring(ptr);
X}
X
X/* bindtokey:    add a new key to the key binding table        */
X
Xbindtokey(f, n)
X
Xint f, n;    /* command arguments [IGNORED] */
X
X{
X    register unsigned int c;/* command key to bind */
X    register int (*kfunc)();/* ptr to the requested function to bind to */
X    register KEYTAB *ktp;    /* pointer into the command table */
X    register int found;    /* matched command flag */
X    char outseq[80];    /* output buffer for keystroke sequence */
X    int (*getname())();
X
X    /* prompt the user to type in a key to bind */
X    mlwrite(": bind-to-key ");
X
X    /* get the function name to bind it to */
X    kfunc = getname();
X    if (kfunc == NULL) {
X        mlwrite("[No such function]");
X        return(FALSE);
X    }
X    ostring(" ");
X
X    /* get the command sequence to bind */
X    c = getckey((kfunc == meta) || (kfunc == cex) ||
X                (kfunc == unarg) || (kfunc == ctrlg));
X
X    /* change it to something we can print as well */
X    cmdstr(c, &outseq[0]);
X
X    /* and dump it out */
X    ostring(outseq);
X
X    /* if the function is a prefix key */
X    if (kfunc == meta || kfunc == cex ||
X        kfunc == unarg || kfunc == ctrlg) {
X
X        /* search for an existing binding for the prefix key */
X        ktp = &keytab[0];
X        found = FALSE;
X        while (ktp->k_fp != NULL) {
X            if (ktp->k_fp == kfunc)
X                unbindchar(ktp->k_code);
X            ++ktp;
X        }
X
X        /* reset the appropriate global prefix variable */
X        if (kfunc == meta)
X            metac = c;
X        if (kfunc == cex)
X            ctlxc = c;
X        if (kfunc == unarg)
X            reptc = c;
X        if (kfunc == ctrlg)
X            abortc = c;
X    }
X
X    /* search the table to see if it exists */
X    ktp = &keytab[0];
X    found = FALSE;
X    while (ktp->k_fp != NULL) {
X        if (ktp->k_code == c) {
X            found = TRUE;
X            break;
X        }
X        ++ktp;
X    }
X
X    if (found) {    /* it exists, just change it then */
X        ktp->k_fp = kfunc;
X    } else {    /* otherwise we need to add it to the end */
X        /* if we run out of binding room, bitch */
X        if (ktp >= &keytab[NBINDS]) {
X            mlwrite("Binding table FULL!");
X            return(FALSE);
X        }
X
X        ktp->k_code = c;    /* add keycode */
X        ktp->k_fp = kfunc;    /* and the function pointer */
X        ++ktp;            /* and make sure the next is null */
X        ktp->k_code = 0;
X        ktp->k_fp = NULL;
X    }
X    return(TRUE);
X}
X
X/* unbindkey:    delete a key from the key binding table    */
X
Xunbindkey(f, n)
X
Xint f, n;    /* command arguments [IGNORED] */
X
X{
X    register int c;        /* command key to unbind */
X    char outseq[80];    /* output buffer for keystroke sequence */
X
X    /* prompt the user to type in a key to unbind */
X    mlwrite(": unbind-key ");
X
X    /* get the command sequence to unbind */
X    c = getckey(FALSE);        /* get a command sequence */
X
X    /* change it to something we can print as well */
X    cmdstr(c, &outseq[0]);
X
X    /* and dump it out */
X    ostring(outseq);
X
X    /* if it isn't bound, bitch */
X    if (unbindchar(c) == FALSE) {
X        mlwrite("[Key not bound]");
X        return(FALSE);
X    }
X    return(TRUE);
X}
X
Xunbindchar(c)
X
Xint c;        /* command key to unbind */
X
X{
X    register KEYTAB *ktp;    /* pointer into the command table */
X    register KEYTAB *sktp;    /* saved pointer into the command table */
X    register int found;    /* matched command flag */
X
X    /* search the table to see if the key exists */
X    ktp = &keytab[0];
X    found = FALSE;
X    while (ktp->k_fp != NULL) {
X        if (ktp->k_code == c) {
X            found = TRUE;
X            break;
X        }
X        ++ktp;
X    }
X
X    /* if it isn't bound, bitch */
X    if (!found)
X        return(FALSE);
X
X    /* save the pointer and scan to the end of the table */
X    sktp = ktp;
X    while (ktp->k_fp != NULL)
X        ++ktp;
X    --ktp;        /* backup to the last legit entry */
X
X    /* copy the last entry to the current one */
X    sktp->k_code = ktp->k_code;
X    sktp->k_fp   = ktp->k_fp;
X
X    /* null out the last one */
X    ktp->k_code = 0;
X    ktp->k_fp = NULL;
X    return(TRUE);
X}
X
Xdesbind(f, n)    /* describe bindings
X           bring up a fake buffer and list the key bindings
X           into it with view mode            */
X
X#if    APROP
X{
X    buildlist(TRUE, "");
X}
X
Xapro(f, n)    /* Apropos (List functions that match a substring) */
X
X{
X    char mstring[NSTRING];    /* string to match cmd names to */
X    int status;        /* status return */
X
X    status = mlreply("Apropos string: ", mstring, NSTRING - 1);
X    if (status != TRUE)
X        return(status);
X
X    return(buildlist(FALSE, mstring));
X}
X
Xbuildlist(type, mstring)  /* build a binding list (limited or full) */
X
Xint type;    /* true = full list,   false = partial list */
Xchar *mstring;    /* match string if a partial list */
X
X#endif
X{
X#if    ST520 & LATTICE
X#define    register
X#endif
X    register WINDOW *wp;    /* scanning pointer to windows */
X    register KEYTAB *ktp;    /* pointer into the command table */
X    register NBIND *nptr;    /* pointer into the name binding table */
X    register BUFFER *bp;    /* buffer to put binding list into */
X    char *strp;        /* pointer int string to send */
X    int cpos;        /* current position to use in outseq */
X    char outseq[80];    /* output buffer for keystroke sequence */
X
X    /* split the current window to make room for the binding list */
X    if (splitwind(FALSE, 1) == FALSE)
X            return(FALSE);
X
X    /* and get a buffer for it */
X    bp = bfind("Binding list", TRUE, 0);
X    if (bp == NULL || bclear(bp) == FALSE) {
X        mlwrite("Can not display binding list");
X        return(FALSE);
X    }
X
X    /* let us know this is in progress */
X    mlwrite("[Building binding list]");
X
X    /* disconect the current buffer */
X        if (--curbp->b_nwnd == 0) {             /* Last use.            */
X                curbp->b_dotp  = curwp->w_dotp;
X                curbp->b_doto  = curwp->w_doto;
X                curbp->b_markp = curwp->w_markp;
X                curbp->b_marko = curwp->w_marko;
X        }
X
X    /* connect the current window to this buffer */
X    curbp = bp;    /* make this buffer current in current window */
X    bp->b_mode = 0;        /* no modes active in binding list */
X    bp->b_nwnd++;        /* mark us as more in use */
X    wp = curwp;
X    wp->w_bufp = bp;
X    wp->w_linep = bp->b_linep;
X    wp->w_flag = WFHARD|WFFORCE;
X    wp->w_dotp = bp->b_dotp;
X    wp->w_doto = bp->b_doto;
X    wp->w_markp = NULL;
X    wp->w_marko = 0;
X
X    /* build the contents of this window, inserting it line by line */
X    nptr = &names[0];
X    while (nptr->n_func != NULL) {
X
X        /* add in the command name */
X        strcpy(outseq, nptr->n_name);
X        cpos = strlen(outseq);
X
X#if    APROP
X        /* if we are executing an apropos command..... */
X        if (type == FALSE &&
X            /* and current string doesn't include the search string */
X            strinc(outseq, mstring) == FALSE)
X            goto fail;
X#endif
X        /* search down any keys bound to this */
X        ktp = &keytab[0];
X        while (ktp->k_fp != NULL) {
X            if (ktp->k_fp == nptr->n_func) {
X                /* padd out some spaces */
X                while (cpos < 25)
X                    outseq[cpos++] = ' ';
X
X                /* add in the command sequence */
X                cmdstr(ktp->k_code, &outseq[cpos]);
X                strcat(outseq, "\n");
X
X                /* and add it as a line into the buffer */
X                if (linstr(outseq) != TRUE)
X                    return(FALSE);
X
X                cpos = 0;    /* and clear the line */
X            }
X            ++ktp;
X        }
X
X        /* if no key was bound, we need to dump it anyway */
X        if (cpos > 0) {
X            outseq[cpos++] = '\n';
X            outseq[cpos] = 0;
X            if (linstr(outseq) != TRUE)
X                return(FALSE);
X        }
X
Xfail:        /* and on to the next name */
X        ++nptr;
X    }
X
X    curwp->w_bufp->b_mode |= MDVIEW;/* put this buffer view mode */
X    curbp->b_flag &= ~BFCHG;    /* don't flag this as a change */
X    wp->w_dotp = lforw(bp->b_linep);/* back to the beginning */
X    wp->w_doto = 0;
X    wp = wheadp;            /* and update ALL mode lines */
X    while (wp != NULL) {
X        wp->w_flag |= WFMODE;
X        wp = wp->w_wndp;
X    }
X    mlwrite("");    /* clear the mode line */
X    return(TRUE);
X}
X
X#if    APROP
Xstrinc(source, sub)    /* does source include sub? */
X
Xchar *source;    /* string to search in */
Xchar *sub;    /* substring to look for */
X
X{
X    char *sp;    /* ptr into source */
X    char *nxtsp;    /* next ptr into source */
X    char *tp;    /* ptr into substring */
X
X    /* for each character in the source string */
X    sp = source;
X    while (*sp) {
X        tp = sub;
X        nxtsp = sp;
X
X        /* is the substring here? */
X        while (*tp) {
X            if (*nxtsp++ != *tp)
X                break;
X            else
X                tp++;
X        }
X
X        /* yes, return a success */
X        if (*tp == 0)
X            return(TRUE);
X
X        /* no, onward */
X        sp++;
X    }
X    return(FALSE);
X}
X#endif
X
X/* get a command key sequence from the keyboard    */
X
Xunsigned int getckey(mflag)
X
Xint mflag;    /* going for a meta sequence? */
X
X{
X    register unsigned int c;    /* character fetched */
X    char tok[NSTRING];        /* command incoming */
X
X    /* check to see if we are executing a command line */
X    if (clexec) {
X        macarg(tok);    /* get the next token */
X        return(stock(tok));
X    }
X
X    /* or the normal way */
X    if (mflag)
X        c = get1key();
X    else
X        c = getcmd();
X    return(c);
X}
X
X/* execute the startup file */
X
Xstartup(sfname)
X
Xchar *sfname;    /* name of startup file (null if default) */
X
X{
X    char *fname;    /* resulting file name to execute */
X
X    /* look up the startup file */
X    if (*sfname != 0)
X        fname = flook(sfname, TRUE);
X    else
X        fname = flook(pathname[0], TRUE);
X
X    /* if it isn't around, don't sweat it */
X    if (fname == NULL)
X        return(TRUE);
X
X    /* otherwise, execute the sucker */
X    return(dofile(fname));
X}
X
X/*    Look up the existance of a file along the normal or PATH
X    environment variable. Look first in the HOME directory if
X    asked and possible
X*/
X
Xchar *flook(fname, hflag)
X
Xchar *fname;    /* base file name to search for */
Xint hflag;    /* Look in the HOME environment variable first? */
X
X{
X    register char *home;    /* path to home directory */
X    register char *path;    /* environmental PATH variable */
X    register char *sp;    /* pointer into path spec */
X    register int i;        /* index */
X    static char fspec[NSTRING];    /* full path spec to search */
X    char *getenv();
X
X#if    ENVFUNC
X
X    if (hflag) {
X        home = getenv("HOME");
X        if (home != NULL) {
X            /* build home dir file spec */
X            strcpy(fspec, home);
X            strcat(fspec, "/");
X            strcat(fspec, fname);
X
X            /* and try it out */
X            if (ffropen(fspec) == FIOSUC) {
X                ffclose();
X                return(fspec);
X            }
X        }
X    }
X#endif
X
X    /* always try the current directory first */
X    if (ffropen(fname) == FIOSUC) {
X        ffclose();
X        return(fname);
X    }
X
X#if    ENVFUNC
X    /* get the PATH variable */
X    path = getenv("PATH");
X    if (path != NULL)
X        while (*path) {
X
X            /* build next possible file spec */
X            sp = fspec;
X#if    ST520 & MWC
X            while (*path && (*path != PATHCHR) && (*path != ','))
X#else
X            while (*path && (*path != PATHCHR))
X#endif
X                *sp++ = *path++;
X
X            /* add a terminating dir separator if we need it */
X            if (sp != fspec)
X#if    ST520
X                *sp++ = '\\';
X#else
X                *sp++ = '/';
X#endif
X            *sp = 0;
X            strcat(fspec, fname);
X
X            /* and try it out */
X            if (ffropen(fspec) == FIOSUC) {
X                ffclose();
X                return(fspec);
X            }
X
X#if    ST520 & MWC
X            if ((*path == PATHCHR) || (*path == ','))
X#else
X            if (*path == PATHCHR)
X#endif
X                ++path;
X        }
X#endif
X
X    /* look it up via the old table method */
X    for (i=2; i < NPNAMES; i++) {
X        strcpy(fspec, pathname[i]);
X        strcat(fspec, fname);
X
X        /* and try it out */
X        if (ffropen(fspec) == FIOSUC) {
X            ffclose();
X            return(fspec);
X        }
X    }
X
X    return(NULL);    /* no such luck */
X}
X
Xcmdstr(c, seq)    /* change a key command to a string we can print out */
X
Xint c;        /* sequence to translate */
Xchar *seq;    /* destination string for sequence */
X
X{
X    char *ptr;    /* pointer into current position in sequence */
X
X    ptr = seq;
X
X    /* apply meta sequence if needed */
X    if (c & META) {
X        *ptr++ = 'M';
X        *ptr++ = '-';
X    }
X
X    /* apply ^X sequence if needed */
X    if (c & CTLX) {
X        *ptr++ = '^';
X        *ptr++ = 'X';
X    }
X
X    /* apply SPEC sequence if needed */
X    if (c & SPEC) {
X        *ptr++ = 'F';
X        *ptr++ = 'N';
X    }
X
X    /* apply control sequence if needed */
X    if (c & CTRL) {
X        *ptr++ = '^';
X    }
X
X    c = c & 255;    /* strip the prefixes */
X
X    /* and output the final sequence */
X
X    *ptr++ = c;
X    *ptr = 0;    /* terminate the string */
X}
X
X/*    This function looks a key binding up in the binding table    */
X
Xint (*getbind(c))()
X
Xint c;    /* key to find what is bound to it */
X
X{
X    register KEYTAB *ktp;
X
X        ktp = &keytab[0];                       /* Look in key table.   */
X        while (ktp->k_fp != NULL) {
X                if (ktp->k_code == c)
X                        return(ktp->k_fp);
X                ++ktp;
X        }
X
X    /* no such binding */
X    return(NULL);
X}
X
X/* getfname:    This function takes a ptr to function and gets the name
X        associated with it
X*/
X
Xchar *getfname(func)
X
Xint (*func)();    /* ptr to the requested function to bind to */
X
X{
X    register NBIND *nptr;    /* pointer into the name binding table */
X
X    /* skim through the table, looking for a match */
X    nptr = &names[0];
X    while (nptr->n_func != NULL) {
X        if (nptr->n_func == func)
X            return(nptr->n_name);
X        ++nptr;
X    }
X    return(NULL);
X}
X
Xint (*fncmatch(fname))() /* match fname to a function in the names table
X                and return any match or NULL if none        */
X
Xchar *fname;    /* name to attempt to match */
X
X{
X    register NBIND *ffp;    /* pointer to entry in name binding table */
X
X    /* scan through the table, returning any match */
X    ffp = &names[0];
X    while (ffp->n_func != NULL) {
X        if (strcmp(fname, ffp->n_name) == 0)
X            return(ffp->n_func);
X        ++ffp;
X    }
X    return(NULL);
X}
X
X/* stock:    String key name TO Command Key        */
X
Xunsigned int stock(keyname)
X
Xchar *keyname;        /* name of key to translate to Command key form */
X
X{
X    register unsigned int c;    /* key sequence to return */
X
X    /* parse it up */
X    c = 0;
X
X    /* first, the META prefix */
X    if (*keyname == 'M' && *(keyname+1) == '-') {
X        c = META;
X        keyname += 2;
X    }
X
X    /* next the function prefix */
X    if (*keyname == 'F' && *(keyname+1) == 'N') {
X        c |= SPEC;
X        keyname += 2;
X    }
X
X    /* control-x as well... (but not with FN) */
X    if (*keyname == '^' && *(keyname+1) == 'X'&& !(c & SPEC)) {
X        c |= CTLX;
X        keyname += 2;
X    }
X
X    /* a control char? */
X    if (*keyname == '^' && *(keyname+1) != 0) {
X        c |= CTRL;
X        ++keyname;
X    }
X    if (*keyname < 32) {
X        c |= CTRL;
X        *keyname += 'A';
X    }
X
X
X    /* make sure we are not lower case (not with function keys)*/
X    if (*keyname >= 'a' && *keyname <= 'z' && !(c & SPEC))
X        *keyname -= 32;
X
X    /* the final sequence... */
X    c |= *keyname;
X    return(c);
X}
X
Xchar *transbind(skey)    /* string key name to binding name.... */
X
Xchar *skey;    /* name of keey to get binding for */
X
X{
X    char *bindname;
X    unsigned int stock();
X    int (*getbind())();
X
X    bindname = getfname(getbind(stock(skey)));
X    if (bindname == NULL)
X        bindname = "ERROR";
X
X    return(bindname);
X}
FRIDAY_NIGHT
echo mes.1 completed!
# That's all folks!