Relay-Version: version B 2.10 5/3/83; site utzoo.UUCP
Path: utzoo!utgpu!water!watmath!clyde!cbosgd!mandrill!hal!ncoast!allbery
From: allbery@ncoast.UUCP
Newsgroups: comp.sources.misc
Subject: MicroEmacs 3.9 (Part 1 of 16)
Message-ID: <5648@ncoast.UUCP>
Date: Sat, 14-Nov-87 16:05:32 EST
Article-I.D.: ncoast.5648
Posted: Sat Nov 14 16:05:32 1987
Date-Received: Tue, 17-Nov-87 05:18:17 EST
Sender: allbery@ncoast.UUCP
Lines: 1432
Approved: allbery@ncoast.UUCP
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!