!<arch>
makefile        511458641   1094  1000  100644  3163      `
CC = cc68
# DumpableEmacs is Spencer Thomas's dump-emacs facility
# newmalloc is the CalTech power-of-2 malloc, suitably modified

CFLAGS= -l -O -DNewC -Dmalloc=Malloc -Drealloc=Realloc
obj=TrmTERM.mob TrmV200.mob TrmVT100.mob TrmWy75.mob abbrev.mob abspath.mob \
    arithmetic.mob arrows.mob bcpy.mob buffer.mob casefiddle.mob columns.mob \
    dbmanager.mob display.mob dsp.mob emacs.mob errlog.mob filecomp.mob \
    fileio.mob keyboard.mob lispfuncs.mob macros.mob metacoms.mob minibuf.mob \
    mlisp.mob ndbm.mob options.mob search.mob simplecoms.mob sindex.mob \
    sleep.mob subprogram.mob syntax.mob undo.mob window.mob windowman.mob \
    spell.mob alloc.mob

.SUFFIXES:
.SUFFIXES:	.c .a68 .mob
.c.mob:;	$(CC) -c $(CFLAGS) $*.c
.a68.mob:;	$(CC) $(CFLAGS) $*.a68

temacs: ${obj}
	rm -f temacs femacs.mob
	$(CC) ${CFLAGS} version.c ${obj} -o temacs
	mv temacs femacs.mob

TrmTERM.mob: TrmTERM.c config.h keyboard.h display.h Trm.h
TrmV200.mob: TrmV200.c display.h Trm.h
TrmVT100.mob: TrmVT100.c display.h Trm.h
TrmWy75.mob: TrmWy75.c display.h Trm.h
abbrev.mob: abbrev.c abbrev.h buffer.h window.h keyboard.h syntax.h macros.h mlisp.h
abspath.mob: abspath.c config.h keyboard.h mlisp.h
arithmetic.mob: arithmetic.c mlisp.h keyboard.h buffer.h window.h
arrows.mob: buffer.h keyboard.h window.h arrows.c
buffer.mob: buffer.c config.h buffer.h window.h syntax.h abbrev.h keyboard.h mlisp.h
casefiddle.mob: casefiddle.c buffer.h window.h keyboard.h syntax.h
columns.mob: columns.c buffer.h window.h
dbmanager.mob: dbmanager.c config.h ndbm.h buffer.h window.h keyboard.h
display.mob: display.c display.h Trm.h mlisp.h window.h keyboard.h
dsp.mob: dsp.c display.h window.h buffer.h config.h keyboard.h Trm.h subprogram.h
emacs.mob: emacs.c buffer.h window.h macros.h keyboard.h config.h mlisp.h
errlog.mob: errlog.c buffer.h config.h window.h keyboard.h search.h
filecomp.mob: buffer.h window.h keyboard.h mlisp.h config.h
fileio.mob: fileio.c keyboard.h window.h buffer.h config.h mlisp.h macros.h
keyboard.mob: keyboard.c keyboard.h window.h buffer.h config.h mlisp.h subprogram.h
lispfuncs.mob: lispfuncs.c buffer.h window.h macros.h mlisp.h config.h keyboard.h
macros.mob: macros.c  keyboard.h macros.h buffer.h
metacoms.mob: metacoms.c buffer.h window.h keyboard.h syntax.h macros.h
minibuf.mob: minibuf.c keyboard.h window.h buffer.h mlisp.h
mlisp.mob: mlisp.c keyboard.h mlisp.h buffer.h window.h macros.h config.h search.h Trm.h
ndbm.mob: ndbm.c ndbm.h
options.mob: options.c buffer.h window.h macros.h config.h display.h mlisp.h keyboard.h Trm.h
search.mob: search.c keyboard.h window.h buffer.h syntax.h mlisp.h search.h
simplecoms.mob: simplecoms.c keyboard.h window.h buffer.h mlisp.h macros.h syntax.h
sindex.mob: sindex.c
spell.mob: spell.c buffer.h config.h keyboard.h mlisp.h window.h
subprogram.mob: subprogram.c buffer.h keyboard.h mlisp.h subprogram.h window.h
syntax.mob: syntax.c syntax.h buffer.h window.h keyboard.h mlisp.h
undo.mob: undo.c undo.h buffer.h window.h keyboard.h
window.mob: window.c config.h keyboard.h buffer.h display.h window.h Trm.h mlisp.h
windowman.mob: windowman.c buffer.h window.h keyboard.h
alloc.mob: alloc.c

Trm.h           509135003   1094  1000  100644  2932      `
/* terminal control module header file */

/*		Copyright (c) 1981,1980 James Gosling		*/

struct TrmControl {
    int     (*t_topos) ();	/* move the cursor to the indicated
				   (row,column); (1,1) is the upper left */
    int     (*t_reset) ();	/* reset terminal (screen is in unkown state,
				   convert it to a known one) */
    int     (*t_INSmode) ();	/* set or reset character insert mode */
    int     (*t_HLmode) ();	/* set or reset highlighting */
    int     (*t_CURmode) ();	/* disable/enable cursor display */
    int     (*t_inslines) ();	/* insert n lines */
    int     (*t_dellines) ();	/* delete n lines */
    int     (*t_blanks) ();	/* print n blanks */
    int     (*t_init) ();	/* initialize terminal settings */
    int     (*t_cleanup) ();	/* clean up terminal settings */
    int     (*t_wipeline) ();	/* erase to the end of the line */
    int     (*t_wipescreen) ();	/* erase the entire screen */
    int     (*t_delchars) ();	/* delete n characters */
    int     (*t_writechars) ();	/* write characters; either inserting or
				   overwriting according to the current
				   character insert mode. */
    int     (*t_window) ();	/* set the screen window so that IDline
				   operations only affect the first n
				   lines of the screen */
    int     (*t_flash) ();	/* Flash the screen -- not set if this
				   terminal type won't support it. */
/* costs are expressed as number_affected*mf + ov
	cost to wipe one line: KLov
	cost to insert/delete 1 line: (number of lines left)*ILmf+ILov
	cost to insert one character: (number of chars left on line)*ICmf+ICov
	csot to insert n spaces: n*ISmf+ISov
	cost to delete n characters:  n*DCmf+DCov */
    int     t_KLov;		/* wipe line overhead */
    float   t_ILmf;		/* insert lines multiply factor */
    int     t_ILov;		/* insert lines overhead */
    float   t_ICmf;		/* insert character multiply factor */
    int     t_ICov;		/* insert character overhead */
    float   t_ISmf;		/* insert space multiply factor */
    int     t_ISov;		/* insert space overhead */
    float   t_DCmf;		/* delete character multiply factor */
    int     t_DCov;		/* delete character overhead */
    int     t_length;		/* screen length */
    int     t_width;		/* screen width */
    int     t_needspaces;	/* set true iff the terminal needs to have
				   real spaces in the middle of lines in
				   order to have character insertion work --
				   this only matters on terminals that
				   distinguish between real and imaginary
				   blanks. */
};

#define MissingFeature 99999	/* IC and IL overheads should be set to this
				   value if the corresponding feature is
				   missing */
struct TrmControl tt;		/* terminal specific information for the
				   current display */

/* Screen size depends if level1 emulator (v200em) is in use */
#ifdef apm
#define rows	*((char *) 0x3fa0)
#define cols	*((char *) 0x3fa1)
#else
#define rows	24
#define cols	80
#endif
abbrev.h        508005720   1094  1000  100644  1256      `
/* Definitions for Unix Emacs Abbrev mode */

/*		Copyright (c) 1981,1980 James Gosling		*/

/* An abbrev table contains an array of pointers to abbrev entries.  When a
   word is to be looked up in a abbrev table it is hashed to a long value and
   that value is taken mod the array size to get the head of the appropriate
   chain.  The chain is scanned for an entry whose hash matches (comparing
   hash values is faster than comparins strings) and whose string matches. */

#define AbbrevSize 87

struct AbbrevEnt {		/* a phrase-abbreve pair in an abbrev table */
     struct AbbrevEnt *a_next;	/* the next pair in this chain */
     char *a_abbrev;		/* the abbreviation */
     char *a_phrase;		/* the expanded phrase */
     long a_hash;		/* a_abbrev hashed */
     struct BoundName *a_ExpansionHook;	/* the command that will be executed
					   when this abbrev is expanded */
};

struct AbbrevTable {		/* a table of abbreviations and their
				   expansions */
    char *a_name;		/* the name of this abbrev table */
    int a_NumberDefined;	/* the number of abbrevs defined in this
				   abbrev table */
    struct AbbrevEnt *a_table[AbbrevSize];
				/* the array of pointers to chains of name
				   pairs */
};

struct AbbrevTable GlobalAbbrev;
buffer.h        508005721   1094  1000  100644  7797      `
/* Header file for the buffer manipulation primitives */

/*		Copyright (c) 1981,1980 James Gosling		*/

/* Modified 7-Dec-80 DJH	Maintain list of buffer names for ^x^o */

enum BufferKinds {		/* the "kinds" of stuff that can be in a
				   buffer */
	FileBuffer,		/* Contains info from a file (
				   (WriteModifiedFiles will dump it) */
	ScratchBuffer,		/* Scratch stuff -- automatically generated
				   by emacs for stuff like ^X^B */
	MacroBuffer,		/* contains the body of a macro, in which
				   case the file name is actually the macro
				   name */
	DeletedBuffer		/* A buffer that has been deleted */
};

struct ModeSpecific {		/* Per-buffer mode-specific information */
    char md_ModeString[30];	/* The commentary string that appears in
				   the modeline of each window */
    char md_ModeFormat[80];	/* The format of the mode line for this
				   buffer */
    char md_PrefixString[20];	/* The auto-newline prefix string */
    int md_AbbrevOn;		/* true iff abbrev mode has been enabled for
				   this buffer */
    int md_FoldCase;		/* true iff case folded comparisons are
				   to be done */
    struct AbbrevTable *md_abbrev;	/* the abbrev table in use in this
					   buffer */
    struct SyntaxTable *md_syntax;	/* the syntax table in use in this
					   buffer */
    int  md_RightMargin;	/* Right margin for auto-newline */
    int  md_LeftMargin;		/* Left margin for auto-newline */
    int  md_CommentColumn;	/* Comment column for auto-newline */
    int  md_NeedsCheckpointing;	/* true iff this buffer needs to be
				   checkpointed */
    int  md_TabSize;		/* The size of one tab stop, 8 usually */
    int  md_HeadClip;		/* The number of characters clipped off the
				   head of the buffer by restrict-region +1 */
    int  md_TailClip;		/* The number of characters clipped off the
				   tail of the buffer by restrict-region */
    struct keymap *md_keys;	/* Keys that are bound local to this buffer
				   (stuff like $J) */
    int  md_ReadOnly;		/* True iff file is considered read-only */
};

/* structure that defines a buffer */
struct buffer {
/* An Emacs buffer is maintained as a single block of storage that
   contains all of the text involved (eg. the entire contents of a
   file, we're depending on the paging system to do a lot of work
   for us).  This block is divided into two parts, which when
   concatenated form one long text string.  The gap in the middle is
   to allow insertions and deletions to be performed without
   repeated copying of the entire buffer contents.  "dot" will not
   necessarily be positioned at the gap, but if any insertions or
   deletions are to be done around "dot" then the gap must be moved.

   |<---------------size---------------------------------->|
   |<-----b_size1----->|<---b_gap--->|<------b_size2------>|
   ^--b_base								*/

    char *b_base;		/* points to the beginning of the
				   block of storage used to hold the
				   text in the buffer */
    char *b_name;		/* the name of this buffer */
    int b_size;			/* the number of characters in the
				   block pointed to by b_base.  Not
				   all of the characters in the
				   block may be valid */
    int b_size1;		/* the number of characters in the
				   first part of the block */
    int b_gap;			/* the number of characters in the
				   gap between the two parts */
    int b_size2;		/* the number of characters in the
				   second part of the block */
    int b_EphemeralDot;		/* The value that dot had the last time that
				   this buffer was visible in a window or
				   accessed in any way */
    char *b_fname;		/* the name of the file associated
				   with this buffer */
    int b_modified;		/* true iff this buffer has been
				   modified since it was last
				   written */
    int b_BackedUp;		/* true iff this buffer has been been backed
				   up (if you write to its associated file
				   and it hasn't been backed up, then a
				   backup will be made) */
    int b_checkpointed;		/* the value of b_modified at the last
				   checkpoint.  Since b_modified is actually
				   a count of the number of changes made
				   (which gets zeroed when the file is
				   written), deciding whether or not to
				   checkpoint is done on the basis of the
				   difference between b_modified and
				   b_checkpointed */
    char *b_checkpointfn;	/* file name used for checkpointing this
				   buffer */
    struct buffer *b_next;	/* the next buffer in the chain of
				   extant buffers */
    struct marker *b_markset;	/* the markers that refer to this
				   buffer */
    struct marker *b_mark;	/* The distinguished mark (set by
				   ^@) for this buffer */
    enum BufferKinds b_kind;	/* The kind of thing in this buffer */
    struct ModeSpecific b_mode;	/* The mode specific information for this
				   buffer */
    struct BoundName *b_AutoFillHook;	/* The command that will be executed
					   when the right margin is passed */
};

struct buffer *bf_cur;		/* the current buffer */

char *savestr();		/* saves a string in managed core */
char *sprintf();		/* the usual printf to a string */
char *sprintfl();		/* sprintf with a length argument */

/* the following are derived from fields of the current buffer; when
   switching buffers these are saved back into and restored from a
   buffer structure */
char *bf_p1;			/* b_base-1 */
char *bf_p2;			/* b_base+gap-1 (used to reference
				   characters in the second part) */
int bf_s1;			/* b_size1 */
int bf_s2;			/* b_size2 */
int bf_gap;			/* b_gap */
int bf_modified;		/* b_modified */
struct ModeSpecific bf_mode;	/* b_mode */

struct buffer *buffers;		/* root of the list of extant
				   buffers */
struct buffer *minibuf;		/* The minibuf */

#define FirstCharacter bf_mode.md_HeadClip
				/* the first visible character in the
				   buffer */
#define NumCharacters (bf_s1+bf_s2-bf_mode.md_TailClip)
				/* The number of characters visible in the
				   buffer */

char **BufNames;		/* List of buffer names */
int  NBuffers;			/* How many buffers */
int  BufNameFree;		/* How much space left over */
				/* BufNameFree >= 1 for null at end */

/* return the character at position n in the current buffer; n had
   better be in bounds! n=1 is the first character */
#define CharAt(n) *(((n)>bf_s1 ? bf_p2 : bf_p1) + (n))

struct buffer *FindBf ();	/* find the named buffer; returns
				   nil if not found */
struct buffer *NewBf ();	/* create a new buffer */
struct buffer *DelToBuf ();	/* Delete/move text into a buffer */
#define InsStr(s) InsCStr (s, strlen(s))
				/* insert the given string in the
				   current buffer at dot */


/* structure that defines a marker */
struct marker {
/* A marker is conceptually a (buffer,position) pair.  m_buf
   indicates which buffer is marked, and m_pos indicates which
   position is marked.  All markers for a particular buffer are
   chained together by m_next, rooted at b_markset.  The
   interpretation if m_pos is rather odd: it is the index from the
   beginning of the allocated area (b_base) of the marked position
   -- it is not the character number of the marked position.  This
   interpretation causes markers to be invariant over insertions and
   deletions, the only things that affect them are gap motions,
   which should be far less frequent. */
    struct buffer *m_buf;	/* the buffer that this marker
				   refers to */
    int m_pos;			/* the position in the buffer of the
				   character referred to */
    int m_modified;		/* true iff this marker has been
				   modified since it was set */
    struct marker *m_next;	/* the next marker that is chained
				   to the same buffer */
    struct marker *m_prev;	/* back pointer in marker chain */
};

struct marker *CopyMark (/*dst,src*/);	/* copy the value of a marker */
struct marker *NewMark();	/* create a new marker */

config.h        509301759   1094  1000  100644  4022      `
/* Emacs configuration file -- all site-dependant definitions should be made
   here.  Each site should only have to edit this file. */

#ifndef SystemName
#define SystemName "freddy"
#endif
				/* Define this symbol to be a string that
				   represents the name of your site */
#define BackupExtension ".bak"	/* This string gets appended to filenames to
				   generate the file name used for making
				   backups.  The folks at BBN like to use the
				   string "~" because it takes up fewer
				   characters. */
#define CheckpointExtension ".CKP"	/* This string gets appended to
					   filenames to generate the file
					   name used for making
					   checkpoints. */
/* #define PrependExtension	/* If this is defined then the backup and
				   checkpoint extensions will be prepended to
				   the file name, rather than appended.  Some
				   folks like to use (for example) # as the
				   first character of a filename to indicate
				   that it can be deleted if it's more than
				   a few days old. */
#ifdef apm
#define subprograms		/* Enables the pseudo-subprocess stuff
				   on the APM */
#endif
/* #define subprocesses		/* Define this symbol if you want the
				   subprocess control stuff.  This works
				   on modified 4.1BSD Unix systems, and on
				   4.1a/4.1c systems.  On 4.1, it uses the
				   mpxio facility.
				   Even those sites that can run it might not
				   want to, since it induces people to use
				   more cycles. */
#ifndef PATH_LOADSEARCH
#define PATH_LOADSEARCH ":emacs"
#endif
				/* the default search path for loading macro
				   packages */
#define DefaultProfile "emacs:profile.ml"
				/* If a user doesn't have a ".emacs_pro" in
				   their home directory, then the
				   DefaultProfile file is used as their
				   profile instead */
#define OneEmacsPerTty		/* Define this symbol if only one Emacs is
				   allowed to run per tty.  This is usually
				   only necessary to get around an obnoxious
				   bug in the mpxio facility which is used
				   when the subprocess control feature is
				   used.  If you define subprocesses, then
				   you should define this symbol -- unless
				   you have fixed the kernel bug */
#define OneEmacsWarning		/* Define this symbol to make it harder for
				   people to run more than one Emacs. */
/* #define MailOriginator	((char *) FullNameFromGecos(pw)) */
#define MailOriginator pw->pw_name
				/* MailOriginator should be an expression
				   that will evaluate to the name of the
				   originator of a message.  "pw" is set to
				   point to a passwd struct for the current
				   user.  At CMU we put a users full name in
				   the pw_gecos field, so we use that as the
				   name for the originator -- our mail system
				   understands such full names as message
				   destinations.  Other folks might want to
				   use pw->pw_name.  This is also used to
				   evaluate users-full-name. */
#define AddSiteName		/* Define this if you want the name of the
				   origninating site to be added to the
				   "from" field of outgoing mail. */
#define CatchSig		/* Define this to catch SIGINT and SIGTERM
				   (although they may have to be sent from
				   another terminal) */
/* #define MPXcode		/* Define this to get the 4.1BSD mpx-file-
				   based multiprocessing; otherwise the
				   4.1[ac] ptys will be used. */
/* #define TTYconnect		/* Define this to get the 4.1[ac] ipc
				   features for "unexpected" opens.  You
				   always get this when MPXcode is defined. */
/* #define BSD41c		/* Define this if you are running 4.1c. */
#define LIBNDIR			/* Define this to use the directory I/O
				   library (4.1[ac]). */
#define	MaxPathNameLen	64	/* Maximum path name length expected.
				   Many routines will die if this is
				   exceeded, so make it big enough!! */
#define	EmacsVersionNum 85	/* Version number (for schan.c) -- be sure
				   to change to 264 if running Emacs #264! */

#ifdef apm
#define DIRDELIMC	':'
#define DIRDELIMS	":"
#else
#define DIRDELIMC	'/'
#define DIRDELIMS	"/"
#endif
display.h       508005722   1094  1000  100644  1629      `
/* Ultra-hot screen management package
 *		James Gosling, January 1980
 */

#include "Trm.h"

#define ScreenLength (tt.t_length)
#define ScreenWidth (tt.t_width)

int	ScreenGarbaged,		/* true => screen content is uncertain. */
	DoHighlights,		/* true => hightlights should be done */
	cursX,			/* X and Y coordinates of the cursor */
	cursY,			/* between updates. */
	CurrentLine,		/* current line for writing to the virtual
				 * screen. */
	IDdebug,		/* line insertion/deletion debug switch */
	RDdebug,		/* line redraw debug switch */
	left;			/* number of columns left on the current
				 * line of the virtual screen. */
char
	*cursor;		/* pointer into a line object, indicates
				 * where to put the next character */

/* 'dsputc' places a character at the current position on the display,
 * the character must be a simple one, taking up EXACTLY one position on
 * the screen.  ie. tabs and \n's shouldn't be passed to dsputc. */
#define dsputc(c) (--left>=0 ? *cursor++ = c : 0)

/* 'setpos' positions the cursor at position (row,col) in the virtual
 * screen
setpos(row,col);

/* set up highlights for the rectangular region extending from the BottomRow
 * to the TopRow and from the LeftColumn to the RightColumn.  This highlight
 * will be applied when next the screen is updated.
BoxHighlight(TopRow,BottomRow,LeftCol,RightCol)

/* 'UpdateScreen' updates the physical screen, assuming that it looks
 * like the 'CurrentScreen', making it look like the 'DesiredScreen'.
 * If 'copy' is true then after calling UpdateScreen the DesiredScreen
 * will be unchanged, otherwise it will be blank.
UpdateScreen(copy);

 */

keyboard.h      508005723   1094  1000  100644  7153      `
/* key->procedure mapping table definitions */

/*		Copyright (c) 1981,1980 James Gosling		*/

#define Ctl(c) ((c)&037)

struct ProgNode {		/* a node in an MLisp (minimal lisp)
				   program node */
    struct BoundName *p_proc;	/* The dude that executes this node */
    short p_nargs;		/* The number of arguments to this node */
    int p_active:1;		/* True iff this node is being executed. */
    struct ProgNode *p_args[1];	/* The actual arguments -- this is really
				   an extensible array (!!!) */
};

/* The things that an executable symbol can be bound to */
enum BindingKind {
    ProcBound,			/* a wired-in procedure */
    MacroBound,			/* a macro (string) */
    MLispBound,			/* an MLisp function */
    AutoLoadBound,		/* a function to be autoloaded */
    KeyBound,			/* bound to a keymap */
};

struct BoundName {		/* a name-procedure/macro binding */
    union {
	char   *b_body;		/* body of the macro to which this name
				   is bound */
	int     (*b_proc) ();	/* pointer to the procedure to which
				   this name is bound */
	struct ProgNode *b_prog;	/* The MLisp program node to which
					   this name is bound */
	struct keymap *b_keymap;	/* The keymap to which this name is
					   bound */
    } b_bound;
    char   *b_name;		/* the name to which this procedure or
				   macro is bound */
    enum BindingKind b_binding;	/* The kind of thing this symbol is bound
				   to */
    int     b_active:1;		/* true iff this (macro) is active --
				   prevents recursive macro calls */
};

#ifdef NewC
struct BoundNameProc {		/* a name-procedure binding */
				/* needed because C won't let us statically
				   initialize unions */
/*  union {
	char   *b_body;		/* body of the macro to which this name
				   is bound */
	int     (*b_proc) ();	/* pointer to the procedure to which
				   this name is bound
    } b_bound; */
    char   *b_name;		/* the name to which this procedure or
				   macro is bound */
    enum BindingKind b_binding;	/* The kind of thing this symbol is bound
				   to */
};
#endif

struct keymap {
    struct BoundName *k_binding[0200];
};

/* keymaps are structured as trees: an entry in a keymap can point to yet
   another keymap -- this is how prefix keys are handled.  Looking up a key
   in a keymap is an FSM-like traversal.  The global and local maps are
   traversed in parallel when reading keystrokes. */
struct keymap *NextGlobalKeymap;	/* The "global" keymap to be used for
					   the next key lookup; null=>use
					   Globalmap */
struct keymap *NextLocalKeymap;	/* The "local" keymap to be used for the next
				   key lookup; null=>use the map associated
				   with the current buffer. */
struct keymap GlobalMap;	/* default global key bindings */
struct keymap *CurrentGlobalMap;	/* Current global keymap */
struct keymap ESCmap;		/* The keymap used for globally bound
				   ESC-prefixed default commands */
struct keymap MinibufLocalMap;	/* The keymap used by the minibuf for local
				   bindings when spaces are allowed in the
				   minibuf */
struct keymap MinibufLocalNSMap;/* The keymap used by the minibuf for local
				   bindings when spaces are not allowed in
				   the minibuf */
struct keymap CtlXmap;		/* The keymap used for globally bound
				   ^X-prefixed default commands */
struct BoundName **NewNames;	/* points into the list of bound macro
				   names; used for initialization */
int (*LastProc)();		/* the last procedure called -- used by
				   folks like ^N and ^P to decide whether
				   or not they should calculate a new
				   column */
int arg;			/* argument to this command */
enum ArgStates {		/* the possible states that the
				   prefix-argument scanning could be in */
	NoArg, HaveArg, PreparedArg
} ArgState;

#define MemLen 1000
int MemUsed;			/* the length of the keyboard macro */
char KeyMem[MemLen];		/* the contents of the keyboard macro */
int Remembering;		/* true iff we're in "remember" mode */

#ifndef FILE
#include <stdio.h>
#endif
FILE *InputFD;			/* file structure from which commands are
				   to be read */
FILE *fopenp();			/* open a file given a search path */
struct BoundName **LookupKeys();	/* Lookup a bound name given the
					   sequence of keystrokes that is
					   supposed to invoke it */
char *KeyToStr ();		/* Given a sequence of keystrokes, return it
				   as something printable (eg. as "ESC-F") */
char *MemPtr;			/* pointer into the currently-being-expanded
				   macro body */
struct ProgNode *CurExec;	/* the program node that is currently being
				   executed */
int LastArgUsed;		/* the index (in CurExec->p_args) of the last
				   argument fetched via getstr. */

/* true iff we're processing interactive input */
#define interactive (InputFD==stdin && MemPtr==0 && CurExec==0)


#ifdef NewC
#define setkey(map, k, proc, nm) { static struct BoundNameProc b \
		= {proc, nm, ProcBound}; \
	map.k_binding[k] = (struct BoundName *) &b; }
#else
#define setkey(map, k, proc, nm) { static struct BoundName b; \
	b.b_name = nm; b.b_bound.b_proc = proc; \
	map.k_binding[k] = &b; }
#endif
#define synkey(map1,new,map2,old) map1.k_binding[new] = map2.k_binding[old]
	
#ifdef NewC
#define defproc(proc, nm) { static struct BoundNameProc b \
		= {proc, nm, ProcBound}; \
	*NewNames++ = (struct BoundName *) &b; }
#else
#define defproc(proc, nm) { static struct BoundName b; \
	b.b_name = nm; b.b_bound.b_proc = proc; \
	*NewNames++ = &b; }
#endif

/* Defines an MLisp callable function whose value will be the given integer */
#define IntFunc(name,val) static name () { \
	MLvalue -> exp_type = IsInteger; \
	MLvalue -> exp_int = val; \
	return 0; \
}

/* Defines an MLisp callable function whose value will be the given marker */
#define MarkFunc(name,val) static name () { \
	MLvalue -> exp_type = IsMarker; \
	MLvalue -> exp_v.v_marker = NewMark(); \
	SetMark (MLvalue -> exp_v.v_marker, bf_cur, val); \
	MLvalue -> exp_release = 1; \
	return 0; \
}

/* Defines an MLisp callable function whose value will be the given string */
#define StrFunc(name,val) static name () { \
	MLvalue -> exp_type = IsString; \
	MLvalue -> exp_v.v_string = val; \
	MLvalue -> exp_release = 0; \
	MLvalue -> exp_int = strlen(MLvalue -> exp_v.v_string); \
	return 0; \
}

char LastKeyStruck;		/* The last key struck as a command */
int MetaFlag;			/* True iff keyboard has a meta key */
int InputPending;		/* True iff keyboard input is known to be
				   pending */
int RecurseDepth;		/* Depth of recursion in recursive edits */
int MinibufDepth;		/* Depth of recursion in minibuf edits */
int PreviousCommand;		/* This is the value of last-key-struck for
				   the previous command.  It can be set by
				   assigning to the variable
				   previous-command, but this change will not
				   actually occur until the next command is
				   executed.  Useful for kill commands that
				   are supposed to chain together */
int ThisCommand;		/* The value returned for (previous-command)
				   in this command, it is the value of the
				   previous-command variable set by the
				   previous command */
int LastRedisplayPaused;	/* True iff the last redisplay paused
				   because input from the keyboard was
				   seen. */

macros.h        508005724   1094  1000  100644  398       `
/* header file for stuff that has to do with macros */

/*		Copyright (c) 1981,1980 James Gosling		*/

#define maxmacs 600		/* Maximum number of macros that may be
				   defined.  Sorry; can't really use a
				   dynamic structure. */
char *MacNames[maxmacs+1];	/* The names of the macros */
struct BoundName *MacBodies[maxmacs];	/* their bodies */
int NMacs;			/* the number of macros defined */
map.h           508005724   1094  1000  100644  3021      `
/* This header file is used only for the short-name hack.  Emacs was written
   for VAX Unix, Berkeley release 4, whose C compiler allows arbitrarily long
   identifiers with all characters significant.  I have a hacked-over version
   of cpp which allows long macro names and which effectivly prefixes each
   file with a '#include "map.h"'.  Map.h contains macro definitions to
   translate the long names into unique short ones. */
#define putenv(s1,s2) 

#define AbbrevTable AbrvT
#define AbbrevTableNames AbrvTN
#define ArgumentPrefixcnt ArgPfxC
#define BackupByCopying BkupByC
#define BackupByCopyingWhenLinked BkupWhL
#define BackwardCharacter BackChr
#define BackwardParagraph BackPgh
#define BackwardParen BackPar
#define BackwardParenBL BackPrB
#define BackwardWord BackWrd
#define BeginningOfFile BegFile
#define BeginningOfLine BegLine
#define BeginningOfWindow BegWind
#define BufNameFree BufNmFr
#define BufNames BufNms
#define CaseRegionCapitalize RegCap
#define CaseRegionInvert RegInv
#define CaseRegionLower RegLow
#define CaseRegionUpper RegUpp
#define CaseWordCapitalize WrdCap
#define CaseWordInvert WrdInv
#define CaseWordLower WrdLow
#define CaseWordUpper WrdUpp
#define ChangeDirectory ChDir
#define CompareSetup ComparS
#define CompareReturn ComparR
#define CurrentBufferName CurBNam
#define CurrentLine CurLINE
#define CurrentMode CurMODE
#define CurrentFileName CurFNam
#define DefaultCommentColumn DefComC
#define DefaultFoldCase DefFold
#define DefaultLeftMargin DefLeft
#define DefaultRightMargin DefRite
#define DefaultWordMode DefWord
#define DeleteNextCharacter DelNChr
#define DeleteNextWord DelNWrd
#define DeleteOtherWindows DelOWin
#define DeletePreviousCharacter DelPChr
#define DeletePreviousWord DelPWrd
#define DeleteToKillbuffer DelTKB
#define DeleteWindow DelWinC
#define DescribeBindings DesBind
#define DescribeCommand DesCom
#define DescribeKey DesKey
#define DescribeVariable DesVar
#define DescribeWordInBuffer DesWrd
#define ExecuteExtendedCommand ExExCom
#define ExecuteKeyboardMacro ExKey
#define ExecuteMLispBuffer ExMLbuf
#define ExecuteMLispLine ExMLlin
#define ExecuteMLispInput ExMLinp
#define ExecuteMacro ExMac
#define ExecuteMonitorCommand ExMon
#define ForwardCharacter FwdChr
#define ForwardParagraph FwdPgh
#define ForwardParen FwdPar
#define ForwardParenBL FwdParB
#define ForwardWord FwdWrd
#define GreaterEqual GtrEql
#define Newline NewL
#define NewlineAndBackup NewLBck
#define NewlineAndIndent NewLInd
#define NextError NextEC
#define NextInitVarDesc NextIVD
#define NextInitVarName NextIVN
#define PreviousLine PrevLine
#define PreviousPage PrevPage
#define PreviousWindow PrevWin
#define ReadAbbrevs ReadAb
#define ReadAbbrevFile ReadAbF
#define SetMarkCommand SetMCom
#define ScrollOneLineDown ScrlDn
#define ScrollOneLineUp ScrlUp
#define SyntaxTable SynTab
#define SyntaxTableEntry SynTabE
#define SyntaxTableNames SynTabN
#define VisitFileCommand VisitFCom
#define WriteAbbrevs WritAb
#define WriteAbbrevFile WritAbF
#define WriteFileExit WrtFilE

mlisp.h         508005726   1094  1000  100644  4350      `
/* Header file for dealing with values returned by mlisp functions */

/*		Copyright (c) 1981,1980 James Gosling		*/

char *LoadSearchPath;		/* The load search path for mlisp files.
				   Set to environment EPATH (if any), or
				   PATH_LOADSEARCH if not specified */

struct VariableName {		/* a name for a variable with a pointer
				   to it's chain of interpretations. */
    char   *v_name;		/* the name of the variable */
    struct Binding *v_binding;	/* the most recent binding of this
				   variable */
};

enum Kinds {			/* The data types possible for MLisp values */
    IsVoid, IsInteger, IsString, IsMarker, IsArray
};

typedef struct {		/* a value that can be returned from the
				   evaluation of a MLisp expression */
    enum Kinds exp_type;	/* the kind of expression we're dealing
				   with */
    int     exp_int;		/* an integer value */
    union res_union {
	char *v_string;		/* if IsString */
	struct marker *v_marker;/* if IsMarker */
	struct array *v_array;	/* if IsArray */
    } exp_v;
    int     exp_release:1;	/* true iff this fellow points to a string
				   in managed memory */
    int     exp_refcnt;		/* reference count for some very simple
				   garbage collection */
}               Expression;

struct Binding {		/* a particular (name,value) binding */
    struct Binding *b_inner;	/* the next inner binding for the same
				   name */
    Expression *b_exp;		/* The value held by this variable */
    union {
	struct buffer *b_LocalTo;	/* The buffer that this binding is
					   local too */
	struct Binding *b_Default;	/* The default value for this system
					   variable */
    } b;
    int     IsSystem:1;		/* true iff this is a system variable,
				   in which case b_string points to the
				   variable, be it string or integer. */
    int	    BufferSpecific:1;	/* True iff the variable is buffer specific */
    int     IsDefault:1;	/* True iff this is the default value entry */
};

char **VarNames;		/* variable name table */
struct VariableName **VarDesc;	/* the corresponding descriptions */
int NVars;			/* the number of variables declared */
int VarTSize;			/* the size of the variable table */
char **NextInitVarName;		/* where to stick the next variable name
				   when initializing Emacs */
struct VariableName **NextInitVarDesc;
				/* where to stick the next variable
				   descriptor when initializing Emacs */

#define DefIntVar(name, addr) { \
    static Expression e; \
    static struct Binding b; \
    static struct VariableName v; \
    *NextInitVarName++ = v.v_name = name; \
    b.b_exp = &e; \
    b.IsSystem = 1; \
    v.v_binding = &b; \
    e.exp_type = IsInteger; \
    e.exp_v.v_string =  (char *) (addr); \
    *NextInitVarDesc++ = &v; \
}

#define DefStrVar(name, addr) { \
    static Expression e; \
    static struct Binding b; \
    static struct VariableName v; \
    *NextInitVarName++ = v.v_name = name; \
    b.b_exp = &e; \
    b.IsSystem = 1; \
    v.v_binding = &b; \
    e.exp_v.v_string =  addr; \
    e.exp_int = sizeof addr; \
    e.exp_type = IsString; \
    *NextInitVarDesc++ = &v; \
}

#define SetSysDefault NextInitVarDesc[-1]->v_binding->b.b_Default \
		= NextInitVarDesc[-2]->v_binding

/* Release any storage associated with Expression block e */
#define ReleaseExpr(e) (e && ((e) -> exp_release || --(e) -> exp_refcnt<=0) \
		? DoRelease (e) : 0)

Expression *MLvalue;		/* the value returned from the last
				   evaluation */
Expression GlobalValue;		/* The thing that MLvalue usually points to */

struct ExecutionStack {		/* traceback/argument-evaluation stack for
				   MLisp functions */
    struct ProgNode *CurExec;	/* the expression being executed at this
				   level */
    struct ExecutionStack *DynParent;	/* pointer to the dynamically
					   enclosing parent of this execution
					   frame */
    int PrefixArgument;		/* The argument prefixed to this invocation */
    int PrefixArgumentProvided;	/* true iff there really was an argument
				   prefixed to this invocation.  If there
				   wasn't, then the value of PrefixArgument
				   will be 1 */
};

struct ExecutionStack ExecutionRoot;	/* The root of the execution stack.
					   As MLisp functions are executed
					   their environment info (an
					   ExecutionStack struct) is built
					   here after copying its parents
					   information into a local struct. */
ndbm.h          508005727   1094  1000  100644  1077      `
/* This set of data base routines was ripped off from the Unix standard ones,
   with a few changes: data base entries aren't (key,value) pairs, they are
   simply datum's which have two imbedded longs which for the value.  Also,
   you can deal with multiple data bases */

#define	PBLKSIZ	4096		/* Page block size */
#define	DBLKSIZ	4096		/* directory block size */
#define	BYTESIZ	8		/* bits per byte */

typedef struct {
    long    bitno;
    long    maxbno;
    long    blkno;
    long    hmask;

    long    oldpagb;
    long    olddirb;
    char    pagbuf[PBLKSIZ];
    char    dirbuf[DBLKSIZ];

    int     dirf;
    int     pagf;
    int     datf;
    char   *dbnm,
           *dirnm,
           *datnm,
           *pagnm;
    int     dbrdonly;
}               database;

database * lastdatabase;

typedef struct {
    char   *dptr;
    int     dsize;
    long    val1,
            val2;
}               datum;

datum fetch ();
datum makdatum ();
datum firstkey ();
datum nextkey ();
datum firsthash ();
long    calchash ();
long    hashinc ();
database *open_db ();

search.h        508005731   1094  1000  100644  939       `
/* The types for search globals to be saved by SaveExcursion */

#define	ESIZE	500		/* the maximum size of an RE */
#define	NBRA	9		/* the maximum number of meta-brackets in an
				   RE -- \( \) -- cant handle >9 */
#define NALTS	10		/* the maximum number of \|'s */

struct search_globals {	
    char expbuf[ESIZE + 4];	/* The most recently compiled search string */
    char *alternatives[NALTS];	/* The list of \| seperated alternatives */
    int braslist[NBRA];		/* RE meta-bracket start list */
    int braelist[NBRA];		/* RE meta-bracket end list */
    int loc1;			/* The buffer position of the first
				   character of the most recently found
				   string */
    int loc2;			/* The buffer position of the character
				   following the most recently found string */
    int nbra;			/* The number of meta-brackets in the most
				   recently compiled RE */
    char *TRT;			/* The current translation table */
} search_globals;

subprogram.h    508005880   1094  1000  100644  878       `
typedef int (*PFI)();
#define PKeyBoardGet	(*(int (**)()) 0x35d6)
#define PScreenPut	(*(int (**)()) 0x3fa4)
#define NULLFUNC	((PFI) NULL)
#define	emask		(*((int *) 0X003724L))
#define ClearSPI	(SPInput.point = SPInput.end = (char *) 0, \
			 SPInput.startmark = (struct marker *) 0, \
			 SPInput.flag = 0, \
			 SPInput.display = 0)

#define trap(n)		asm("	trap	#15"); \
			asm("	.word	n");

extern PFI KeyBoardGet;
extern PFI ScreenPut;
extern PFI InputRoutine;
extern PFI OutputRoutine;
struct InputNode {
	char *point;		/* next character to go to subprogram */
	char *end;		/* one beyond last character */
	struct marker *startmark; /* eob at beginning of recursive edit */
	char flag;		/* 0: send EOF at end,
				   1: recursively ProcessKeys at end */
	char display;		/* 0: don't
				   1: once per line
				   2: once per character */
};
extern struct InputNode SPInput;
syntax.h        508005729   1094  1000  100644  1232      `
/* Declarations having to do with Emacs syntax tables */

/*		Copyright (c) 1980 James Gosling		*/

/* A syntax table contains an array of information, one entry per ASCII
   character. */

struct SyntaxTable {
    struct SyntaxTableEntry {
	enum SyntaxKinds {
	    DullChar,		/* a dull (punctuation) character */
	    WordChar,		/* a word character for ESC-F and
				   friends */
	    BeginParen,		/* a begin paren: (<[{ */
	    EndParen,		/* an end paren: )>]} */
	    PairedQuote,	/* like " or ' in C */
	    PrefixQuote,	/* like \ in C */
	} s_kind:4;
	char    MatchingParen;	/* contains the matching paren if this
				   is a beginning or ending parenthesis 
				*/
    /* The following fields are used in scanning comments.  They handle
       single and double character comment delimiters */
	unsigned
            BeginComment:1,	/* true iff this character begins a
				   comment */
            EndComment:1;	/* true iff this character ends a
				   comment */
	char    CommentAux;	/* the second character in a
				   two-character sequence */
    }                       s_table[128];
    char   *s_name;
};

struct SyntaxTable GlobalSyntaxTable;

#define CharIs(c, prop) (bf_mode.md_syntax->s_table[c].s_kind == (prop))
undo.h          508005730   1094  1000  100644  1006      `
/* Definitions of objects used by the undo facility */

enum Ukinds {			/* The events that can exist in the undo
				   queue. */
    Uboundary,			/* A boundary between sets of undoable things
				   */
    Unundoable,			/* What's done is done -- some things can't
				   be undone */
    Udelete,			/* Delete characters to perform the undo */
    Uinsert,			/* Insert .... */
};

struct UndoRec {		/* A record of a single undo action */
    enum Ukinds kind;		/* the kind of action to be undone */
    struct buffer *buffer;	/* the buffer where the action takes place */
    int dot;			/* Where dot is */
    int len;			/* The extent of the undo (characters
				   inserted or deleted) */
};

/* The undo history consists of two circular queues, one of characters and
   one of UndoRecs.  When Uinsert recs are added to UndoRQ characters get
   added to UndoCQ.  The position of the characters can be reconstructed by
   subtracting len from the fill pointer. */

#define NUndoR	1000
#define NUndoC	10000
window.h        508005729   1094  1000  100644  3289      `
/* header file for the window manipulation primitives */

/*		Copyright (c) 1981,1980 James Gosling		*/

/* structure that defines a window */
struct window {
/* windows are organized in a double linked list.  Each window has
   its own value of 'dot' and is tied to some buffer */
    struct window *w_prev,	/* preceeding window */
		  *w_next;	/* next window */
    struct buffer *w_buf;	/* buffer tied to this window */
    struct marker *w_dot;	/* value of "dot" for this buffer */
    struct marker *w_start;	/* start character position in the tied
				   buffer of the display */
    int w_height;		/* number of screen lines devoted to
				   this window; includes space for
				   the mode line */
    int w_lastuse;		/* sequence counter for LRU window
				   finding */
    int w_force;		/* true iff the value of start MUST
				   be used on the next redisplay */
};

struct window *wn_cur;		/* current window */
int dot;			/* value of dot from the current
				   window */
int DotCol;			/* print column for the character immediatly
				   to the right of dot (the one that
				   CharAt(dot) gives you) */
int ColValid;			/* true iff DotCol is valid */

/* CurCol returns the current print column number for dot, which may
   have to be calculated */
#define CurCol (ColValid ? DotCol : CalcCol())

/* dot should ONLY be given a value by calling SetDot(new) -- it ensures
   that all associated bookkeeping is done. */
#define SetDot(n) (ColValid = 0, dot = (n))

/* dot should be moved left or right using the following macros -- they
   attempt (or will, eventually) to keep DotCol valid.  They don't check
   the new valid of dot: you have to do that. */
#define DotRight(n) (ColValid = 0, dot += (n))
#define  DotLeft(n) (ColValid = 0, dot -= (n))

struct window *windows;		/* the root of the list of windows */
char *MiniBuf;			/* text to appear in the minibuffer */
char *ResetMiniBuf;		/* the text that the minibuf contents are to
				   be reset to with each display cycle */
int InMiniBuf;			/* true iff the cursor is in the minibuffer */
int err;			/* true iff MiniBuff represents an
				   error message */
char *BrGetstr();		/* get a string from the minibuffer */
char *getstr();			/* get a string from the minibuffer,
				   terminating on CR or ESC */
char *getnbstr();		/* get a string from the minibuffer,
				   terminating on CR, ESC or whitespace */
char *getkey();			/* get a keystroke sequence, where the limits
				   of the sequence are determined by the
				   current keymaps */

/* the following variables are all involved in a rather lamentable
   compromising of principles: doing the full-blown redisplay is just too
   expensive, so we drop hints for later optimization.  These hints
   had better be right!  */
int Cant1LineOpt;		/* true if can't use the one line optimized
				   redisplay */
int Cant1WinOpt;		/* true if can't use the one window optimized
				   redisplay */
int CantEverOpt;		/* true if can't ever use any optimized
				   redisplay (eg. two windows on same
				   buffer) */
int RedoModes;			/* true iff we should redraw the mode lines
				   on the next redisplay */
int DumpMiniBuf;		/* true iff the MiniBuf has changed */
int CtlArrow;			/* true iff control characters are to be
				   displayed with ^'s rather than \nnn */

TrmTERM.c       509653105   1094  1000  100644  8715      `
/* terminal control module for terminals described by TERMCAP */

/*		Copyright (c) 1981,1980 James Gosling		*/

/*	Modified 1-Dec-80 by Dan Hoey (DJH) to understand C100 underlines */
/*	Modified 2-Dec-80 (DJH) to turn off highlighting on insertline */
/*	Modified 4 Aug 81 by JQ Johnson:  use "dm","ei","pc","mi" */
/*	Modified 24-Aug-81 by Jeff Mogul (JCM) at Stanford
 *		- uses "nl" instead of \n in case \n is destructive
 *	Modified 8-Sept-81 by JCM @ Stanford
 *		- re-integrated changes from Gosling since July '81
 *	Modified 22 March 84 by mkc at paisley to get arrow keys from termcap
 */

#include <stdio.h>
#include "config.h"
#include "keyboard.h"
#include "display.h"

static
int	curX, curY;

void vputchar();
char *tgetstr ();
char *UP;
char *BC;
char PC;
short ospeed;

static char *ILstr, *DLstr, *ICstr, *DCstr, *ELstr, *ESstr, *HLBstr,
	*HLEstr, *ICPstr, *ICPDstr, *CursStr, *TIstr, *TEstr,
	*ICEstr, *NDstr, *VBstr, *EDstr, *DMstr, *NLstr,
	*KSstr, *KEstr;
extern char *KUstr, *KDstr, *KRstr, *KLstr;	/* MKC - see arrows.c */
static int ULflag;	/* DJH -- 1 if terminal has underline */
static int MIflag;	/* JQJ -- 1 if safe to move while in insert mode */

static
enum IDmode { m_insert = 1, m_overwrite = 0 }
	CurMode, DesMode;

static
INSmode (new)
enum IDmode new; {
	DesMode = new;
	if(DesMode==m_insert && ICstr==0) abort();
};

static curHL, desHL;
static
HLmode (on) {
    desHL = on;
}

static
setHL () {
    register char *com;
    if (curHL == desHL)
	return;
    if(com = desHL ? HLBstr : HLEstr)
	tputs (com, 0, vputchar);
    curHL = desHL;
}

static
clearHL () {
    if (curHL) {
	register oldes = desHL;
	desHL = 0;
	setHL ();
	desHL = oldes;
    }
}

static
setmode () {
    if (DesMode == CurMode)
	return;
    tputs(DesMode==m_insert ? ICstr : ICEstr, 0, vputchar);
    CurMode = DesMode;
};

static
inslines (n) {
    HLmode (0);		/* DJH -- Don't highlight the inserted line */
    setHL ();
    while (--n >= 0)
	tputs (ILstr, tt.t_length-curY, vputchar);
};

static
dellines (n) {
    while (--n >= 0)
	tputs(DLstr, tt.t_length-curY, vputchar);
};

static
writechars (start, end)
register char	*start,
		*end; {
    setmode ();
    setHL();
    while (start <= end && curX <= tt.t_width) {
	if(CurMode == m_insert && ICPstr) tputs(ICPstr, tt.t_width-curX, vputchar);
			/* DJH -- blank out space before underlines */
	if(*start == '_' && CurMode != m_insert && ULflag != 0) {
		vputchar (' ');
		vputchar (*BC);
	}			
	vputchar (*start++);
	if(CurMode == m_insert && ICPDstr) tputs(ICPDstr, tt.t_width-curX, vputchar);
	curX++;
    }
    if (curX > tt.t_width)
	curX = tt.t_width;
};

static
blanks (n) {
    setmode ();
    setHL ();
    while (--n >= 0 && curX <= tt.t_width) {
	if (CurMode == m_insert && ICPstr)
	    tputs (ICPstr, tt.t_width - curX, vputchar);
	vputchar (' ');
	if (CurMode == m_insert && ICPDstr)
	    tputs (ICPDstr, 1 /* tt.t_width - curX */, vputchar);
	curX++;
    }
    if (curX > tt.t_width)
	curX = tt.t_width;
};

static float BaudFactor;

static pad(n,f)
float   f; {
    register    k = n * f * BaudFactor;
    while (--k >= 0)
	vputchar (PC);
};

static
topos (row, column) {
    clearHL ();			/* many terminals can't hack highlighting
				   around cursor positioning.  Silly twits! */
    if (CurMode==m_insert && ! MIflag) {
	tputs(ICEstr, 0, vputchar);	/* some terminals can't move in */
	CurMode = m_overwrite;		/* insert mode -- JQJ */
    }
    if (curY == row) {
	if (curX == column)
	    return;
	if (curX == column + 1 && (CurMode != m_insert)) {
	    tputs (BC, 0, vputchar);
	    goto done;
	}
	if (curX == column - 1 && NDstr && CurMode != m_insert){
	    tputs (NDstr, 0, vputchar);
	    goto done;
	}
    }
    if (curY - 1 == row && curX == column && UP != 0
		&& CurMode != m_insert){
	tputs (UP, 0, vputchar);
	goto done;
    }
    if ( (curY + 1 == row && (column == 1 || column==curX))
					&& (CurMode != m_insert) ){
	if(column!=curX) putchar (015);
	tputs (NLstr, 0, vputchar);
/*	putchar (012);		JCM */
	goto done;
    }
    tputs(tgoto (CursStr, column-1, row-1), 0, vputchar);
done:
    curX = column;
    curY = row;
};

static
flash () {			/* dump a visible bell */
    tputs (VBstr, 0, vputchar);
}

static
init (BaudRate) {
    static char tbuf[1024];
    static char combuf[1024];
#ifndef apm
    extern  old;
#endif
    char   *fill = combuf;
    static  inited;
    if (!inited)
	if (tgetent (tbuf, getenv ("TERM")) <= 0) {
#ifndef apm
	    stty (1, &old);
	    
#endif
#ifdef OneEmacsPerTty	/* TPM 31-Jan-82 */
	    UnlockTty();
#endif
	    quit (1, "No environment-specified terminal type -- see TSET(1), sh(1)\n");
	}
    inited = 1;
    ILstr = tgetstr ("al", &fill);
    DLstr = tgetstr ("dl", &fill);
    ICstr = tgetstr ("im", &fill);
    ICEstr = tgetstr ("ei", &fill);
    MIflag = tgetflag ("mi");	/* can move in insert mode */
    DCstr = tgetstr ("dc", &fill);
    ELstr = tgetstr ("ce", &fill);
    ESstr = tgetstr ("cl", &fill);
    HLBstr = tgetstr ("so", &fill);
    HLEstr = tgetstr ("se", &fill);
    ICPstr = tgetstr ("ic", &fill);
    ICPDstr = tgetstr ("ip", &fill);
    CursStr = tgetstr ("cm", &fill);
    UP = tgetstr ("up", &fill);
    NDstr = tgetstr ("nd", &fill);
    VBstr = tgetstr ("vb", &fill);
    TIstr = tgetstr ("ti", &fill);
    TEstr = tgetstr ("te", &fill);
    DMstr = tgetstr ("dm", &fill);/* start delete mode */
    EDstr = tgetstr ("ed", &fill);/* end delete mode */
    BC = tgetstr ("bc", &fill);
    if (BC == 0)
	BC = "\b";
    ULflag = tgetflag ("ul");	/* DJH -- Find out about underline */
    NLstr = tgetstr ("nl", &fill);/* JCM -- find out about newline */
    if (NLstr == 0)
	NLstr = "\n";		/*   use default if none specified */
    MetaFlag = tgetflag ("MT");
    KUstr = tgetstr("ku", &fill);
    KDstr = tgetstr("kd", &fill);
    KRstr = tgetstr("kr", &fill);
    KLstr = tgetstr("kl", &fill);
    KSstr = tgetstr("ks", &fill);
    KEstr = tgetstr("ke", &fill);
/*    PC = (tgetstr("pc", &fill)!=0) ? *tgetstr("pc", &fill) : 0; JQJ */
    PC = 0;
    BaudFactor = BaudRate / (5500 - 30 * (float) BaudRate / 96);
    if (CursStr == 0 || UP == 0 || ELstr == 0 || ESstr == 0) {
#ifndef apm
	stty (1, &old);
#endif
#ifdef OneEmacsPerTty	/* TPM 31-Jan-82 */
	UnlockTty();
#endif
	quit (1, "Sorry, this terminal isn't powerful enough to run Emacs.\n\
It is missing some important features.\n");
    }
    tt.t_KLov = strlen(ELstr);
    tt.t_ILmf = BaudFactor * 0.75;
    tt.t_ILov = ILstr ? 2 : MissingFeature;
    if (!ILstr)
	tt.t_inslines = tt.t_dellines = (int (*) ()) - 1;
    if (VBstr)
	tt.t_flash = flash;
    if (ICstr && DCstr) {
	tt.t_ICmf = 1;
	tt.t_ICov = 4;
	tt.t_ISmf = 1;
	tt.t_ISov = 4;
	tt.t_DCmf = 2;
	tt.t_DCov = 0;
    }
    else {
	tt.t_ICmf = MissingFeature;
	tt.t_ICov = MissingFeature;
	tt.t_ISmf = MissingFeature;
	tt.t_ISov = MissingFeature;
	tt.t_DCmf = MissingFeature;
	tt.t_DCov = MissingFeature;
    }
#ifdef apm
    tt.t_length = rows;
    tt.t_width = cols;
#else
    tt.t_length = tgetnum ("li");
    tt.t_width = tgetnum ("co") - (tgetflag ("in") ? 1 : 0);
#endif
};


static
reset () {
    curX = -1;
    curY = -1;
    if (TIstr) tputs(TIstr, 0, vputchar);
    if (KSstr) tputs(ESstr, 0, vputchar);
    topos(1,1);
    tputs(ESstr, 0, vputchar);
    CurMode = m_insert;
    DesMode = m_overwrite;
};

static
cleanup () {
    HLmode (0);
    DesMode = m_overwrite;
    setmode();
    if (TEstr) tputs(TEstr, 0, vputchar);
    if (KEstr) tputs(KEstr, 0, vputchar);
};

static
wipeline () {
    setHL ();
    tputs (ELstr, tt.t_width-curX, vputchar);
};

static
wipescreen () {
    tputs(ESstr, 0, vputchar);
    curX = curY = -1;
};

static
delchars (n) {
    if (DMstr) {	/* we may have delete mode, or delete == insert */
	if (strcmp(DMstr,ICstr)) {
	    if (CurMode  == m_overwrite) {
	        tputs(ICstr,0,vputchar);
		CurMode = m_insert;	/* we're now in both */
	    }
	}
	else {
	    if (CurMode == m_insert) {
		tputs(ICEstr, 0, vputchar);
		CurMode = m_overwrite;
	    }
	    tputs(DMstr,0,vputchar);
        }
    }
    while (--n >= 0) {
	tputs(DCstr, tt.t_width-curX, vputchar);
    }
    if (EDstr) {		/* for some, insert mode == delete mode */
		/* bug!  /etc/termcap pads ICEstr but not EDstr */
        if (strcmp(DMstr,ICstr))
	    CurMode = m_insert;
	else
	    tputs(EDstr,0,vputchar);
    }
};

TrmTERM () {
	tt.t_INSmode = INSmode;
	tt.t_HLmode = HLmode;
	tt.t_inslines = inslines;
	tt.t_dellines = dellines;
	tt.t_blanks = blanks;
	tt.t_init = init;
	tt.t_cleanup = cleanup;
	tt.t_wipeline = wipeline;
	tt.t_wipescreen = wipescreen;
	tt.t_topos = topos;
	tt.t_reset = reset;
	tt.t_delchars = delchars;
	tt.t_writechars = writechars;
	tt.t_window = 0;
	tt.t_length = rows;
	tt.t_width = cols;
};

TrmV200.c       509653195   1094  1000  100644  2702      `
/* terminal control module for Visual 200's */

/* Modified version of Gosling's C100 driver -- jpershing@bbn */

/* Modified again for Visual 200 -- fdc@uk.ac.ed.ecsvax */


#include <stdio.h>
#include "display.h"

static
int	curX, curY;

extern char *KUstr, *KDstr, *KRstr, *KLstr;	/* MKC - see arrows.c */

static curHL;
static
HLmode (on) {
    if (curHL == on)
	return;
    vputs (on ? "\0334" : "\0333" );
    curHL = on;
}

static
inslines (n) {
    while (--n >= 0)
	vputs ("\033L");
};

static
dellines (n) {
    while (--n >= 0)
	vputs ("\033M");
};

static int insertflag;

static
writechars (start, end)
register char	*start,
		*end; {
    if (insertflag) vputs ("\033i");	
    while (start <= end && curX <= cols) {
	vputchar (*start++);
	curX++;
    }
    if (curX > cols) curX = cols;
    if (insertflag) vputs ("\033j");
};

static
blanks (n) {
    if (n <= 0) return;
    if (insertflag) vputs ("\033i");
    if (curX + n > cols)
	n = cols - curX;
    curX += n;
    while (n--) vputchar (' ');
    if (insertflag) vputs ("\033j");
};

static				/* This routine needs lots of work */
topos (row, column) register row, column; {
    if (curY == row) {
	if (curX == column)
	    return;
	if (curX == column + 1) {
	    vputchar (010);
	    goto done;
	}
    }
    if (row == 1 && column == 1) {
	vputs ("\033H");
	goto done;
    }
    vprintf("\033Y%c%c",row+31,column+31);
done: 
    curX = column;
    curY = row;
};

static
init (BaudRate) {
    tt.t_ICmf = MissingFeature;
    tt.t_ISmf = MissingFeature;
    tt.t_DCmf = MissingFeature;
    tt.t_ILmf = 2.0;
    tt.t_KLov = 2;
    tt.t_ICov = MissingFeature;
    tt.t_ISov = MissingFeature;
    tt.t_DCov = MissingFeature;
    tt.t_ILov = 0;
};

static
reset () {
    curHL = 0;
    curX = curY = 1;
    vputs ("\0333\033b\033j\033\\\033l\033G\033d\033k\033H\033v\033=");
};

static
cleanup () {
    HLmode (0);
    topos (tt.t_length, 1);
    wipeline ();
    vputs("\033>");	/* turn off keypad */
};

static
wipeline () {
    vputs ("\033x");
};

static
wipescreen () {
    vputs ("\033v");
    curY = curX = 1;
};

static
INSmode (n) {
    insertflag = n;
}

static
DELchars (n) {
    while (--n >= 0)
	vputs ("\033O");
}

TrmVi200 () {
	KUstr = "\033A";
	KDstr = "\033B";
	KLstr = "\033D";
	KRstr = "\033C";
	tt.t_INSmode = INSmode;
	tt.t_HLmode = HLmode;
	tt.t_inslines = inslines;
	tt.t_dellines = dellines;
	tt.t_blanks = blanks;
	tt.t_init = init;
	tt.t_cleanup = cleanup;
	tt.t_wipeline = wipeline;
	tt.t_wipescreen = wipescreen;
	tt.t_topos = topos;
	tt.t_reset = reset;
	tt.t_delchars = DELchars;
	tt.t_writechars = writechars;
	tt.t_window = 0;
	tt.t_ILmf = 0;
	tt.t_ILov = 0;
	tt.t_length = rows;
	tt.t_width = cols;
};
TrmVT100.c      509653287   1094  1000  100644  3803      `
/* terminal control module for DEC VT100's */

/* Modified version of Gosling's C100 driver -- jpershing@bbn */

/* This is a somewhat primitive driver for the DEC VT100 terminal.  The
   terminal is driven in so-called "ansi" mode, using jump scroll.  It is
   assumed to have the Control-S misfeature disabled (although this
   shouldn't get in the way -- it does anyway).  Specific optimization left
   to be done are (1) deferral of setting the window until necessary (as
   the escape sequence to do this is expensive) and (2) being more clever
   about optimizing motion (as the direct-cursor-motion sequence is also
   quite verbose).  Also, something needs to be done about putting the
   terminal back into slow-scroll mode if that's the luser's preference (or
   perhaps having EMACS itself use slow-scroll mode [lose, lose]).
*/

#include <stdio.h>
#include "display.h"

static
int	curX, curY;
static
int	WindowSize;

static curHL;
static
HLmode (on) {
    if (curHL == on)
	return;
    vputs (on ? "\033[7m" : "\033[m" );
    curHL = on;
}

static
inslines (n) {
    vprintf ("\033[%d;%dr\033[%d;1H", curY, WindowSize, curY);
    curX = 1;
    while (--n >= 0) {
	vputs ("\033M");
	pad (1, 20.);		/* DEC sez pad=30, but what do they know? */
    }
    vputs ("\033[r");
    curX = curY = 1;
};

static
dellines (n) {
    vprintf ("\033[%d;%dr\033[%d;1H", curY, WindowSize, WindowSize);
    curX = 1;
    curY = WindowSize;
    while (--n >= 0) {
	vputs ("\033E");
	pad (1, 20.);		/* [see above comment] */
    }
    vputs ("\033[r");
    curX = curY = 1;
};

static
writechars (start, end)
register char	*start,
		*end; {
    while (start <= end && curX <= cols) {
	vputchar (*start++);
	curX++;
    }
    if (curX > cols)
	curX = cols;
};

static
blanks (n) {
    while (--n >= 0 && curX < cols) {
	vputchar (' ');
	curX++;
    }
};

static float BaudFactor;

static pad(n,f)
float   f; {
    register    k = n * f * BaudFactor;
    while (--k >= 0)
	vputchar (0);
};

static				/* This routine needs lots of work */
topos (row, column) register row, column; {
    if (curY == row) {
	if (curX == column)
	    return;
	if (curX == column + 1) {
	    vputchar (010);
	    goto done;
	}
    }
    if (curY + 1 == row && (column == 1 || column==curX)) {
	if(column!=curX) vputchar (015);
	vputchar (012);
	goto done;
    }
    if (row == 1 && column == 1) {
	vputs ("\033[H");
	goto done;
    }
    vputs ("\033[%d;%dH", row, column );
done:
    curX = column;
    curY = row;
};

static
init (BaudRate) {
    BaudFactor = BaudRate/10000.;
    tt.t_KLov = 15 + 2+BaudFactor*20.;
    tt.t_ILmf = 0.0;
    tt.t_ILov = 15 + 2+BaudFactor*20.;
};

static
reset () {
    vputs ("\033<\033[r\033[m\033[?4l\033[?6l\033[2J");
    pad (1, 45.);
    WindowSize = tt.t_length;
    curHL = 0;
    curX = curY = 1;
};

static
cleanup () {
    HLmode (0);
    window (0);
    topos (WindowSize, 1);
    wipeline ();
};

static
wipeline () {
    vputs ("\033[K");
    pad (1, 2.);
};

static
wipescreen () {
    vputs ("\033[2J");
    pad (1, 45.);
};

static
window (n) {
    if (n <= 0 || n > tt.t_length)
	n = tt.t_length;
    WindowSize = n;
}

static
INSmode (n) {
    /* no-op */
}

TrmVT100 () {
	tt.t_INSmode = INSmode;
	tt.t_HLmode = HLmode;
	tt.t_inslines = inslines;
	tt.t_dellines = dellines;
	tt.t_blanks = blanks;
	tt.t_init = init;
	tt.t_cleanup = cleanup;
	tt.t_wipeline = wipeline;
	tt.t_wipescreen = wipescreen;
	tt.t_topos = topos;
	tt.t_reset = reset;
	tt.t_delchars = (int (*)()) -1;
	tt.t_writechars = writechars;
	tt.t_window = window;
	tt.t_ILmf = 0;
	tt.t_ILov = 0;
	tt.t_ICmf = MissingFeature;
	tt.t_ICov = MissingFeature;
	tt.t_ISmf = MissingFeature;
	tt.t_ISov = MissingFeature;
	tt.t_DCmf = MissingFeature;
	tt.t_DCov = MissingFeature;
	tt.t_length = rows;
	tt.t_width = cols;
};

TrmWy75.c       509652877   1094  1000  100644  3472      `
/* terminal control module for Wyse75's */

/* Modified version of Gosling's C100 driver -- jpershing@bbn */

/* Modified again for Wyse75's -- fdc@uk.ac.ed.ecsvax	*/

#include <stdio.h>
#include "display.h"

static
int	curX, curY, bottom, curHL, curIns, curCur;

extern char *KUstr, *KDstr, *KRstr, *KLstr;	/* MKC - see arrows.c */

static
HLmode (on) {
    if (curHL == on)
	return;
    vputs (on ? "\033[1m" : "\033[m");
    curHL = on;
}

static
CURmode (on) {
    if (curCur == on)
	return;
    vputs (on ? "\033[?25h" : "\033[?25l");
    curCur = on;
}

static
inslines (n) {
    vprintf (n > 1 ? "\033[%dL" : "\033[L", n);
};

static
dellines (n) {
    vprintf (n > 1 ? "\033[%dM" : "\033[M", n);
};

static
writechars (start, end)
register char	*start,
                *end;
{
    while (start <= end && curX <= cols) {
	vputchar (*start++);
	curX++;
    }
    if (curX > cols)
	curX = cols;
};

static
blanks (n) {
    if (curX + n > cols)
	n = cols - curX;
    curX += n;
    if (n <= 8)
	while (--n >= 0)
	    vputchar (' ');
    else
	vprintf ("\033[%d%c\033[%dG", n, curIns ? '@' : 'X', curX);
};

static
topos (row, column) register    row,
                                column;
{
    if (row > rows || column > cols)
	abort ();
    if (curY == row) {
	if (curX == column)
	    return;
	if (curX == column + 1) {
	    vputchar (010);
	    goto done;
	}
	vprintf ("\033[%dG", column);
	goto done;
    }
    if (curY == row - 1 && column == 1 && curY < bottom) {
	vputs ("\033E");
	goto done;
    }
    if (row == 1 && column == 1) {
	vputs ("\033[H");
	goto done;
    }
    vprintf ("\033[%d;%dH", row, column);
done: 
    curX = column;
    curY = row;
};

static
init (BaudRate) {
    tt.t_KLov = 6;
    tt.t_ICmf = 1.0;
    tt.t_ICov = 8;
    tt.t_ISmf = 0.0;
    tt.t_ISov = 18;
    tt.t_DCmf = 0.4;
    tt.t_DCov = 4;
    tt.t_ILmf = 0.0;
    tt.t_ILov = 4;
};

static
reset () {
    curHL = 0;
    curIns = 0;
    curCur = 1;
    curX = curY = -1;
    vputs ("\033=\033[4l\033[?25h\033[m");	/* initialise modes */
    window (0);
    wipescreen ();
};

static
cleanup () {
    HLmode (0);
    INSmode (0);
    CURmode (1);
    window (0);
    topos (tt.t_length, 1);
    wipeline ();
    vputs ("\033>");		/* turn off keypad */
};

static
wipeline () {
    vputs ("\033[K");
};

static
wipescreen () {
    if (curX != 1 || curY != 1)
	vputs ("\033[H");
    curX = curY = 1;
    vputs ("\033[J");
};

static
window (n) {
    if (n <= 0 || n > tt.t_length)
	n = tt.t_length;
    vprintf ("\033[1;%dr", n);
    curX = curY = -1;
    bottom = n;
}

static
flash () {
    vputs ("\033[>+/\016\017R DING   DONG \016\017@/\033,\033,\033,\033,\033[>+//");
}

static
INSmode (on) {
    if (curIns == on)
	return;
    vputs (on ? "\033[4h" : "\033[4l");
    curIns = on;
}

static
DELchars (n) {
    vprintf ("\033[%dP", n);
}

TrmWy75 () {
    KUstr = "\033[A";
    KDstr = "\033[B";
    KRstr = "\033[C";
    KLstr = "\033[D";
    tt.t_INSmode = INSmode;
    tt.t_HLmode = HLmode;
    tt.t_CURmode = CURmode;
    tt.t_inslines = inslines;
    tt.t_dellines = dellines;
    tt.t_blanks = blanks;
    tt.t_init = init;
    tt.t_cleanup = cleanup;
    tt.t_wipeline = wipeline;
    tt.t_wipescreen = wipescreen;
    tt.t_topos = topos;
    tt.t_reset = reset;
    tt.t_delchars = DELchars;
    tt.t_writechars = writechars;
    tt.t_window = window;
    tt.t_flash = flash;
    tt.t_ILmf = 0;
    tt.t_ILov = 0;
    tt.t_length = rows;
    tt.t_width = cols;
};
abbrev.c        508005720   1094  1000  100644  8607      `
/* Unix Emacs Abbrev mode */

/*		Copyright (c) 1981,1980 James Gosling		*/

#include "buffer.h"
#include "syntax.h"
#include "abbrev.h"
#include "window.h"
#include "keyboard.h"
#include "macros.h"
#include "mlisp.h"
#include <ctype.h>

#define MaxAbbrevTables 40	/* the maximum number of abbrev tables */

static
char *AbbrevTableNames[MaxAbbrevTables];
static
struct AbbrevTable *AbbrevTables[MaxAbbrevTables];
static
int NumberOfAbbrevTables;
static
char *LastPhrase;		/* The phrase that an abbrev expands to, for
				   use by abbrev-expansion */

static unsigned
hash (s)			/* hash an abbrev string */
register char *s;
{
    register    unsigned h = 0;
    while (*s)
	h = h * 31 + *s++;
    return h;
}

static struct AbbrevEnt *
lookup(table, name, h)		/* look up an abbrev in the given table with
				   the given name whose hash is h. */
struct AbbrevTable *table;
char *name;
register unsigned h;
{
    register struct AbbrevEnt  *p = table -> a_table[h % AbbrevSize];
    while (p && (p -> a_hash != h || strcmp (name, p -> a_abbrev) != 0))
	p = p -> a_next;
    return p;
}

static
define (table, abbrev, phrase, proc)	/* in the given abbrev table define the
					   given abbreviation for the given
					   phrase */
struct AbbrevTable *table;
char *abbrev, *phrase;
struct BoundName *proc;
{
    register struct AbbrevEnt  *p,
                              **root;
    register unsigned h = hash (abbrev);
    if (p = lookup (table, abbrev, h))
	free (p -> a_phrase);
    else {
	p = (struct AbbrevEnt  *) malloc (sizeof *p);
	p -> a_hash = h;
	p -> a_abbrev = savestr (abbrev);
	root = &table -> a_table[h % AbbrevSize];
	p -> a_next = *root;
	table -> a_NumberDefined++;
	*root = p;
    }
    p -> a_phrase = phrase;
    p -> a_ExpansionHook = proc;
}

static				/* given the name of an abbrev table, return
				   a pointer to it.  If it doesn't exist,
				   create it */
struct AbbrevTable *locate(name)
char *name;
{
    register    i = 0;
    register struct AbbrevTable *p;
    if(name==0 || *name==0) return 0;
    while (i < NumberOfAbbrevTables)
	if (strcmp (AbbrevTableNames[i], name) == 0)
	    return AbbrevTables[i];
	else i++;
    if (NumberOfAbbrevTables >= MaxAbbrevTables) {
	error ("Too many abbrev tables!");
	return 0;
    }
    p = (struct AbbrevTable *) malloc (sizeof *p);
    AbbrevTables[NumberOfAbbrevTables] = p;
    AbbrevTableNames[NumberOfAbbrevTables] = p -> a_name = savestr (name);
    NumberOfAbbrevTables++;
    p -> a_NumberDefined = 0;
    for (i = 0; i < AbbrevSize; i++)
	p -> a_table[i] = 0;
    return p;
}

static
DefineAbbrev (table, s, EProc)
struct AbbrevTable *table;
char *s;
{
    register char  *abbrev = getnbstr (": define-%s%s-abbrev ",
		EProc ? "hooked-" : "", s);
    register char  *phrase;
    register char *hook;
    int hookinx;
    char    s_abbrev[300];
    if (abbrev == 0)
	return;
    strcpyn (s_abbrev, abbrev, 300);
    phrase = getstr (": define-%s%s-abbrev %s phrase: ",
		EProc ? "hooked-" : "", s, s_abbrev);
    if (phrase == 0)
	return;
    hookinx = -1;
    phrase = savestr (phrase);
    if (EProc && (hookinx = getword (MacNames, "Hooked to procedure: ")) < 0)
	return;
    define (table, s_abbrev, phrase, hookinx < 0 ? 0 : MacBodies[hookinx]);
}

static
DefineGlobalAbbrev () {
    DefineAbbrev (&GlobalAbbrev, "global", 0);
    bf_cur -> b_mode.md_AbbrevOn = bf_mode.md_AbbrevOn = 1;
    return 0;
}

static
DefineLocalAbbrev () {
    if (bf_mode.md_abbrev == 0)
	error ("No abbrev table associated with this buffer.");
    else
	DefineAbbrev (bf_mode.md_abbrev, "local", 0);
    bf_cur -> b_mode.md_AbbrevOn = bf_mode.md_AbbrevOn = 1;
    return 0;
}

static
DefineHookedGlobalAbbrev () {
    DefineAbbrev (&GlobalAbbrev, "global", 1);
    return 0;
}

static
DefineHookedLocalAbbrev () {
    if (bf_mode.md_abbrev == 0)
	error ("No abbrev table associated with this buffer.");
    else
	DefineAbbrev (bf_mode.md_abbrev, "local", 1);
    return 0;
}

TestAbbrevExpand () {
    register char  *abbrev = getnbstr (": test-abbrev-expand ");
    register struct AbbrevEnt  *p;
    if (abbrev == 0)
	return 0;
    p = lookup (&GlobalAbbrev, abbrev, hash (abbrev));
    if (p == 0)
	message ("Abbrev \"%s\" isn't defined", abbrev);
    else
	message ("\"%s\" => \"%s\"  (%d)",
		 p -> a_abbrev, p -> a_phrase, p -> a_hash);
    return 0;
}

AbbrevExpand () {		/* called from SelfInsert to possibly
				   expand the abbrev that preceeds dot */
    register char  *p;
    register    n = dot;
    register struct AbbrevEnt  *a;
    register char   c;
    register int    h;
/*  static ExpandingAbbrev; */
    int rv = 0;
    int     uccount = 0;
    char    buf[200];
/*  if (ExpandingAbbrev) return 0; */
    p = buf + sizeof buf / sizeof buf[0];
    *--p = 0;
    while (--n >= 1 && CharIs (c = CharAt (n), WordChar)) {
	*--p = c;
	if (isupper (c))
	    uccount++, *p += 'a' - 'A';
    }
    h = hash (p);
    if ((!bf_mode.md_abbrev || (a = lookup (bf_mode.md_abbrev, p, h)) == 0)
	    && (a = lookup (&GlobalAbbrev, p, h)) == 0)
	return 0;
    bf_mode.md_AbbrevOn = 0;
    if (a -> a_ExpansionHook) {
	LastPhrase = a -> a_phrase;
/*	ExpandingAbbrev = 1; */
	ExecuteBound (a -> a_ExpansionHook);
/*	ExpandingAbbrev = 0; */
	LastPhrase = 0;
	rv = MLvalue -> exp_type == IsInteger && MLvalue ->exp_int == 0;
    }
    else {
	DelBack (dot, h = buf + sizeof buf / sizeof buf[0] - p - 1);
	DotLeft (h);
	for (p = a -> a_phrase; *p;)
	    SelfInsert (
		    islower (*p) && uccount
		    && (p == a -> a_phrase || uccount > 1
		    && isspace (*(p - 1)))
		    ? toupper (*p++) : *p++);
    }
    bf_mode.md_AbbrevOn = 1;
    return rv;
}

static
UseAbbrevTable () {		/* select a named abbrev table for this
				   buffer and turn on abbrev mode if it
				   or the global abbrev table is
				   non-empty */
    register struct AbbrevTable *p = locate (getnbstr (": use-abbrev-table "));
    if (p == 0)
	return 0;
    bf_cur -> b_mode.md_abbrev = bf_mode.md_abbrev = p;
    if (p -> a_NumberDefined > 0 || GlobalAbbrev.a_NumberDefined > 0)
	bf_cur -> b_mode.md_AbbrevOn = bf_mode.md_AbbrevOn = 1;
    return 0;
}

static
WriteAbbrevs(f,table)		/* write the given abbrev table to file f */
register FILE *f;
register struct AbbrevTable *table;
{
    register    i;
    register struct AbbrevEnt  *p;
    fprintf (f, "%s\n", table -> a_name);
    for (i = 0; i < AbbrevSize;)
	for (p = table -> a_table[i++]; p; p = p -> a_next)
	    fprintf (f, " %s	%s\n", p -> a_abbrev, p -> a_phrase);
}

static  WriteAbbrevFile () {
    register    i;
    register char  *fn = getstr (": write-abbrev-file ");
    register    FILE * f;
    if (fn == 0)
	return 0;
    if ((f = fopen (SaveAbs (fn), "w")) == NULL)
	error ("Can't write %s", fn);
    else {
	for (i = 0; i < NumberOfAbbrevTables; i++)
	    WriteAbbrevs (f, AbbrevTables[i]);
	fclose (f);
    }
    return 0;
}

static
ReadAbbrevs (s)
char *s;
{
    register char  *name = getstr (s);
    register    FILE * f;
    char    buf[500];
    register struct AbbrevTable *table = 0;
    register char  *p, *phrase;
    if (name == 0)
	return 0;
    if ((f = fopen (SaveAbs(name), "r")) == NULL)
	return 1;
    while (fgets (buf, sizeof buf, f) && !err)
	if (*buf != ' ') {
	    for(p=buf; *p; ) if(*p++=='\n') *--p = '\0';
	    table = locate (buf);
	}
	else if(table) {
	    p = buf + 1;
	    while (*p && *p != '\t')
		p++;
	    if(*p==0) {
		error ("Improperly formatted abbrev file.");
		return 0;
	    }
	    *p++ = 0;
	    phrase = p;
	    while(*p && *p!='\n') p++;
	    *p = 0;
	    define (table, buf + 1, savestr (phrase), 0);
	}
    fclose (f);
    return 0;
}

static
ReadAbbrevFile () {
    if (ReadAbbrevs (": read-abbrev-file "))
	error ("Can't find abbrev file");
    return 0;
}

static
QuietlyReadAbbrevFile () {
    ReadAbbrevs (": quietly-read-abbrev-file ");
    return 0;
}

StrFunc (AbbrevExpansion, LastPhrase ? LastPhrase : "")

InitAbbrev () {
    defproc (DefineGlobalAbbrev, "define-global-abbrev");
    defproc (DefineLocalAbbrev, "define-local-abbrev");
    defproc (DefineHookedGlobalAbbrev, "define-hooked-global-abbrev");
    defproc (DefineHookedLocalAbbrev, "define-hooked-local-abbrev");
    defproc (WriteAbbrevFile, "write-abbrev-file");
    defproc (ReadAbbrevFile, "read-abbrev-file");
    defproc (AbbrevExpansion, "abbrev-expansion");
    defproc (QuietlyReadAbbrevFile, "quietly-read-abbrev-file");
    defproc (TestAbbrevExpand, "test-abbrev-expand");
    defproc (UseAbbrevTable, "use-abbrev-table");
    GlobalAbbrev.a_name = AbbrevTableNames[0] = "global";
    AbbrevTables[0] = &GlobalAbbrev;
    NumberOfAbbrevTables = 1;
}

abspath.c       508005720   1094  1000  100644  8394      `
/* convert a pathname to an absolute one, if it is absolute already,
   it is returned in the buffer unchanged, otherwise leading "./"s
   will be removed, the name of the current working directory will be
   prepended, and "../"s will be resolved.

   In a moment of weakness, I have implemented the cshell ~ filename
   convention.  ~/foobar will have the ~ replaced by the home directory of
   the current user.  ~user/foobar will have the ~user replaced by the
   home directory of the named user.  This should really be in the kernel
   (or be replaced by a better kernel mechanism).  Doing file name
   expansion like this in a user-level program leads to some very
   distasteful non-uniformities.

   Another fit of dementia has led me to implement the expansion of shell
   environment variables.  $HOME/mbox is the same as ~/mbox.  If the
   environment variable a = "foo" and b = "bar" then:
	$a	=>	foo
	$a$b	=>	foobar
	$a.c	=>	foo.c
	xxx$a	=>	xxxfoo
	${a}!	=>	foo!

				James Gosling @ CMU
 */

#include "config.h"
#include <sys/types.h>
#include <sys/stat.h>
#include <pwd.h>
#include "keyboard.h"
#include "mlisp.h"
#include "ctype.h"
#ifdef LIBNDIR
#include <sys/dir.h>
#endif LIBNDIR

static char curwd[MaxPathNameLen];/* the current working directory is
				     remembered here.  chdir()'s are
				     trapped and this gets updated. */
char *getenv ();

abspath (nm, buf)		/* input name in nm, absolute pathname
				   output to buf.  returns -1 if the
				   pathname cannot be successfully
				   converted (only happens if the
				   current directory cannot be found) */
char	*nm,
* buf; {
    register char  *s,
                   *d;
    char    lnm[1000];
    s = nm;
    d = lnm;
    while (*d++ = *s)
	if (*s++ == '$') {
	    register char  *start = d;
	    register    braces = *s == '{';
	    register char  *value;
	    while (*d++ = *s)
		if (braces ? *s == '}' : !isalnum (*s))
		    break;
		else
		    s++;
	    *--d = 0;
	    value = getenv (braces ? start + 1 : start);
	    if (value) {
		for (d = start - 1; *d++ = *value++;);
		d--;
		if (braces && *s)
		    s++;
	    }
	}
    d = buf;
    s = curwd;
    nm = lnm;
    if (nm[0] == '~')		/* prefix ~ */
	if (nm[1] == DIRDELIMC || nm[1] == 0)/* ~/filename */
	    if (s = getenv ("HOME")) {
		if (*++nm)
		    nm++;
	    }
	    else
		s = "";
#ifdef apm
	if (!index(nm, DIRDELIMC) && *s) {
		while (*d = *s++) d++;
		*d++ = DIRDELIMC;
	}
	while (*d++ = *nm++);
#else
	else {			/* ~user/filename */
	    register char  *nnm;
	    register struct passwd *pw;
	    for (s = nm; *s && *s != DIRDELIMC; s++);
	    nnm = *s ? s + 1 : s;
	    *s = 0;
	    pw = (struct passwd *) getpwnam (nm + 1);
	    if (pw == 0) {
		error ("\"%s\" isn't a registered user.", nm+1);
		s = "";
	    }
	    else {
		nm = nnm;
		s = pw -> pw_dir;
	    }
	}
    while (*d++ = *s++);
    *(d - 1) = DIRDELIMC;
    s = nm;
    if (*s == DIRDELIMC)
	d = buf;
    while (*d++ = *s++);
    *(d - 1) = DIRDELIMC;
    *d = '\0';
    d = buf;
    s = buf;
    while (*s)
	if ((*d++ = *s++) == DIRDELIMC && d > buf + 1) {
	    register char  *t = d - 2;
	    switch (*t) {
		case DIRDELIMC: 	/* found // in the name */
		    --d;
		    break;
		case '.': 
		    switch (*--t) {
			case DIRDELIMC: /* found /./ in the name */
			    d -= 2;
			    break;
			case '.': 
			    if (*--t == DIRDELIMC) {/* found /../ */
				while (t > buf && *--t != DIRDELIMC);
				d = t + 1;
			    }
			    break;
		    }
		    break;
	    }
	}
    if (*(d - 1) == DIRDELIMC && d > buf+1)
	d--;
    *d = '\0';
#endif
    return 0;
}

/*
 *  getwd - get current working directory  (algorithm from /bin/pwd)
 *
 *  Author:  Mike Accetta, 19-May-78
 *
 **********************************************************************
 * HISTORY
 * 20-Nov-79  Steven Shafer (sas) at Carnegie-Mellon University
 *	Modified (by Mike Accetta) for VAX.  I tried using a "popen" on "pwd"
 *	to achieve the same effect; there's less risk since errors in pwd
 *	don't trash the current directory of the calling program; however,
 *	it takes about two full seconds (this routine takes about zero time).
 *	This routine wins.
 *
 * 10-Jun-83 Chris Kent (cak) at DecWRL
 *	Upgraded to new directory access routines for 4.1cBSD
 *
 * 10-Jul-83 Chris Torek at Umcp-Cs
 *	#ifdefs for new directory vs. straight open/read
 *
 **********************************************************************
 *
 *  Remarks:
 *
 *     The name of the current working directory is copied into
 *  the supplied string `wdir'.  The current working directory
 *  is changed during the execution of the routine and restored
 *  at the end by a chdir(wdir).  If an error occurs the current
 *  working directory is undefined.
 */
#ifndef apm
getwd (wdir)
char   *wdir;
{
#ifdef LIBNDIR

#define isbad(xx)	(xx) == NULL	/* used on opendir() */
#define	readit()	(dirp = readdir (fd))
#define skipit()	0
    struct direct *dirp;
    register DIR *fd;

#else LIBNDIR

#define	isbad(xx)	(xx) < 0	/* used on opendir() (ie open()) */
#define closedir(d)	close (d)
#define opendir(d)	open (d, 0)
#define dirp		(&db)
#define readit()	read (fd, &db, 16) == 16
#define skipit()	db.d_inode == 0
    struct {
	ino_t	d_inode;
	char	d_name[15];		/* long enough to add \0 */
    } db;
    register int fd;

#endif LIBNDIR

    char temp[MaxPathNameLen];
    struct stat sb,
		sbc,
		root;
    register int found;

 /* Initially root */
    strcpy (wdir, DIRDELIMS);
    stat (DIRDELIMS, &root);
#ifndef LIBNDIR
    db.d_name[14] = 0;
#endif LIBNDIR

    for (;;) {
	if (isbad (fd = opendir ("..")))
	    return (-1);
	if (stat (".", &sbc) < 0 || stat ("..", &sb) < 0)
	    goto out;
	if (sbc.st_ino == root.st_ino && sbc.st_dev == root.st_dev) {
	    closedir (fd);
	    return chdir(wdir);
	}

	if (sbc.st_ino == sb.st_ino && sbc.st_dev == sb.st_dev) {
	    closedir (fd);
	    chdir(DIRDELIMS);
	    if (isbad (fd = opendir (".")))
		return (-1);
	    if (stat (".", &sb) < 0)
		goto out;
	/*  scan the root directory for directory with same device  */
	    if (sbc.st_dev != sb.st_dev) {
		while (readit ()) {
		    if (skipit ())
			continue;
		    if (stat (dirp->d_name, &sb) < 0)
			goto out;
		    if (sbc.st_dev == sb.st_dev) {
			sprintfl (temp, sizeof temp,
					"%s%s", dirp->d_name, wdir);
			strcpy (wdir + 1, temp);
			closedir (fd);
			return (chdir(wdir));
		    }
		}
	    }
	    else {
		closedir (fd);
		return (chdir(wdir));
	    }
	}

    /*  scan parent directory for file with inode of current directory  */
	found = 0;
	while (readit ()) {
	    if (skipit ())
		continue;
	    sprintfl (temp, sizeof temp, "../%s", dirp->d_name);
	    if (stat (temp, &sb) >= 0
		    && sb.st_ino == sbc.st_ino
		    && sb.st_dev == sbc.st_dev) {
		closedir (fd);
		found++;
		chdir("..");
		sprintfl (temp, sizeof temp, "%s%s", dirp->d_name, wdir);
		strcpy (wdir + 1, temp);
		break;
	    }
	}
	if (!found)
	    goto out;
    }
out: 
    closedir (fd);
    return (-1);
}
#endif

/* A chdir() that fiddles the global record */
chdirg (dirname)
register char   *dirname; {
    register    ret;
    register char *p;
    char	path1[MaxPathNameLen], path2[MaxPathNameLen];
    for (p = path1; *p++ = *dirname++; ) ;
    *(p-1) = DIRDELIMC;		/* append a '/' so that "cd ~" works */
    *p = 0;
    ret = abspath (path1, path2);
#ifdef apm
    p = path2 + strlen(path2) - 1;
    if (*p = ':') *p = '\0';
#endif
    if (ret == 0 && (ret = chdir(path2)) == 0)
	strcpy (curwd, path2);
    return ret;
}

/* return a pointer to a copy of a file name that has been
   converted to absolute form.  This routine cannot return failure. */
char *SaveAbs (fn)
char *fn; {
    static char buf[MaxPathNameLen];
    if (fn==0) return 0;
    abspath (fn, buf);
    return buf;
}


WorkingDirectory () {
    MLvalue -> exp_type = IsString;
    MLvalue -> exp_v.v_string = curwd;
    MLvalue -> exp_release = 0;
    MLvalue -> exp_int = strlen (MLvalue -> exp_v.v_string);
    return 0;
}


InitAbs () {
    int i;
    if (getwd (curwd) < 0) {
	char *i = getenv ("HOME");
#ifndef apm
	if (i == 0 || chdir(i))
	    chdir(i = DIRDELIMS);
#endif
	strcpy (curwd, i);
	fprintf (stderr, "[NOTE: Changed to directory %s]\r\n", curwd);
	fflush (stderr);
    }
    if ((i = strlen (curwd)) > 1 && curwd[i-1] == DIRDELIMC)
	curwd[i-1] = 0;
#ifdef DumpableEmacs
    if (!Once)
#endif
	defproc (WorkingDirectory, "working-directory");
}
alloc.c         508499238   1094  1000  100644  534       `
/* All emacs memory allocation is redirected through these functions,
 * which ensure that memory allocated during input and output routines
 * recursively called by subprograms is assigned the same heap level
 * as the main program, not the subprogram.
 */

#undef malloc
#undef realloc

char HeapLevel = 0;
extern char *malloc(), *realloc();

char *Malloc(n)
{
	register char *p = malloc(n);
	if (p) p[-4] = HeapLevel;
	return(p);
}

char *Realloc(p, n)
{
	register char *q = realloc(p, n);
	if (q) q[-4] = HeapLevel;
	return(q);
}
arithmetic.c    508005720   1094  1000  100644  9528      `
/* functions to handle MLisp arithmetic */

/*		Copyright (c) 1981,1980 James Gosling		*/

#include "window.h"
#include "buffer.h"
#include "keyboard.h"
#include "mlisp.h"
#include <ctype.h>


/* Check that we were given at least min and at most max arguments.
   Returns true iff there was an error. */
CheckArgs (min, max) {
    register struct ProgNode   *p = CurExec;
    if(err) return 1;
    if (p == 0)
	if (min != 0 || max != 0) {
	    error ("No arguments provided to MLisp function!");
	    return 1;
	}
	else
	    return 0;
    if (p -> p_nargs < min || p -> p_nargs > max && min <= max) {
	error ("Too %s arguments to \"%s\"",
		p -> p_nargs < min ? "few" : "many",
		p -> p_proc -> b_name);
	return 1;
    }
    return 0;
}

/* Evaluate the n'th argument.  Returns true if the evaluation was
   successful */
EvalArg (n) {
    register struct ProgNode   *p = CurExec;
    if (err)
	return 0;
    if (p == 0 || p -> p_nargs < n) {
	error ("Missing argument %d to %s", n,
		p ? p -> p_proc -> b_name : "MLisp function");
	return 0;
    }
    ExecProg (p -> p_args[n - 1]);
    if (err)
	return 0;
    if (MLvalue -> exp_type == IsVoid) {
	error ("\"%s\" didn't return a value; \"%s\" was expecting it to.",
		p -> p_args[n - 1] -> p_proc -> b_name,
		p -> p_proc -> b_name);
	return 0;
    }
    return 1;
}

/* Evaluate and return the n'th numeric argument */
NumericArg (n) {
    if (!EvalArg (n))
	return 0;
    switch (MLvalue -> exp_type) {
	default: 
	    error ("Numeric argument expected.");
	    return 0;
	case IsInteger: 
	    return MLvalue -> exp_int;
	case IsString: 		/* this is a cop-out */
	    {
		register char *p = MLvalue -> exp_v.v_string;
		register neg = 0;
		while (isspace(*p)) p++;
		if (*p=='+' || *p=='-') {
		    neg = *p=='-';
		    p++;
		}
		while (isspace(*p)) p++;
		n = 0;
		while (isdigit(*p) || isspace(*p)) {
		    if (isdigit(*p)) n = n*10 + *p-'0';
		    p++;
		}
		if (*p) error ("String to integer conversion error: \"%s\"",
				MLvalue -> exp_v.v_string);
		if (neg) n = -n;
	    }
	    ReleaseExpr (MLvalue);
	    MLvalue -> exp_type = IsInteger;
	    return n;
	case IsMarker: 
	    {
		register struct buffer *old = bf_cur;
		n = ToMark (MLvalue -> exp_v.v_marker);
		ReleaseExpr (MLvalue);
		MLvalue -> exp_type = IsInteger;
		SetBfp (old);
		return n;
	    }
    }
}

/* Evaluate and return the n'th string argument in MLvalue (returns
   true if all is well) */
StringArg (n) {
    if (!EvalArg (n))
	return 0;
    switch (MLvalue -> exp_type) {
	default: 
	    return 0;
	case IsMarker: 
	    {
		register struct marker *m = MLvalue -> exp_v.v_marker;
		register struct buffer *b = m ? m -> m_buf : 0;
		ReleaseExpr (MLvalue);
		MLvalue -> exp_v.v_string = b
				? b -> b_name
				: "<Bizarre marker>";
		MLvalue -> exp_int = strlen (MLvalue -> exp_v.v_string);
		MLvalue -> exp_type = IsString;
		MLvalue -> exp_release = 0;
		return 1;
	    }
	case IsInteger: 
	    {
		static char buf[20];/* swine!  using static again */
		sprintfl (buf, sizeof buf, "%d", MLvalue -> exp_int);
		MLvalue -> exp_type = IsString;
		MLvalue -> exp_int = strlen (buf);
		MLvalue -> exp_v.v_string = buf;
		MLvalue -> exp_release = 0;
	    }
	case IsString:
	    return 1;
    }
}

/* set up for a simple binary operator */
binsetup () {
    if (CheckArgs (1, 0))
	return 0;
    return NumericArg (1);
}

static plus () {
    register result = binsetup ();
    register i;
    for (i=2; !err && i <= CurExec->p_nargs; i++)
	result += NumericArg(i);
    MLvalue -> exp_int = result;
    return 0;
}

static not () {
    MLvalue -> exp_int = ! NumericArg (1);
    return 0;
}

static  minus () {
    register    result = binsetup ();
    register    i;
    if (!err && CurExec -> p_nargs == 1)
	result = -result;
    else
	for (i = 2; !err && i <= CurExec -> p_nargs; i++)
	    result -= NumericArg (i);
    MLvalue -> exp_int = result;
    return 0;
}

static times () {
    register result = binsetup ();
    register i;
    for (i=2; !err && i <= CurExec->p_nargs; i++)
	result *= NumericArg(i);
    MLvalue -> exp_int = result;
    return 0;
}

static  divide () {
    register    result = binsetup ();
    register    i;
    for (i = 2; !err && i <= CurExec -> p_nargs; i++) {
	register    denom = NumericArg (i);
	if (denom == 0 && !err)
	    error ("Division by zero");
	else
	    result /= denom ? denom : 1;
    }
    MLvalue -> exp_int = result;
    return 0;
}

static  mod () {
    register    result = binsetup ();
    register    i;
    for (i = 2; !err && i <= CurExec -> p_nargs; i++) {
	register    denom = NumericArg (i);
	if (denom == 0 && !err)
	    error ("Mod by zero");
	else
	    result %= denom ? denom : 1;
    }
    MLvalue -> exp_int = result;
    return 0;
}

static shiftleft () {
    register result = binsetup ();
    register i;
    for (i=2; !err && i <= CurExec->p_nargs; i++)
	result <<= NumericArg(i);
    MLvalue -> exp_int = result;
    return 0;
}

static shiftright () {
    register result = binsetup ();
    register i;
    for (i=2; !err && i <= CurExec->p_nargs; i++)
	result >>= NumericArg(i);
    MLvalue -> exp_int = result;
    return 0;
}

static
and () {
    register result = binsetup ();
    register i;
    for (i=2; !err && result && i <= CurExec->p_nargs; i++)
	result = NumericArg(i);
    MLvalue -> exp_int = result;
    return 0;
}

static or () {
    register result = binsetup ();
    register i;
    for (i=2; !err && result==0 && i <= CurExec->p_nargs; i++)
	result = NumericArg(i);
    MLvalue -> exp_int = result;
    return 0;
}

static xor () {
    register result = binsetup ();
    register i;
    for (i=2; !err && i <= CurExec->p_nargs; i++)
	result ^= NumericArg(i);
    MLvalue -> exp_int = result;
    return 0;
}

static
char *GLeftS;			/* left string operand to a comparison
				   operator */
int GLeftI;			/* left integer operand to a comparison
				   operator */

/* Setup to do a comparison operator.  Comparison is
   lexicographic if both operands are strings, numeric
   otherwise */
static
CompareSetup () {
    register char  *LeftS;
    register struct buffer *old = bf_cur;
    int     LeftI;
    if (!EvalArg (1))
	return 0;
    LeftI = MLvalue -> exp_int;
    switch (MLvalue -> exp_type) {
    case IsInteger:
	LeftS = 0;
	break;
    case IsString:
	if (MLvalue -> exp_release) {
	    LeftS = MLvalue -> exp_v.v_string;
	    MLvalue -> exp_release = 0;
	}
	else
	    LeftS = savestr (MLvalue -> exp_v.v_string);
	break;
    case IsMarker:
	LeftI = ToMark (MLvalue -> exp_v.v_marker);
	LeftS = 0;
	ReleaseExpr (MLvalue);
	SetBfp (old);
	break;
    default:
	error ("Illegal operand to comparison operator");
    }
    if (!EvalArg (2)) {
	if(LeftS) free (LeftS);
	return 0;
    }
    if ((MLvalue -> exp_type == IsInteger || MLvalue -> exp_type == IsMarker)
	    && LeftS) {
	LeftI = atoi (LeftS);
	free (LeftS);
	LeftS = 0;
    }
    if (LeftS == 0 && MLvalue -> exp_type == IsString) {
	MLvalue -> exp_int = atoi (MLvalue -> exp_v.v_string);
	ReleaseExpr (MLvalue);
	MLvalue -> exp_type = IsInteger;
    }
    if (MLvalue -> exp_type == IsMarker) {
	register n = ToMark (MLvalue -> exp_v.v_marker);
	ReleaseExpr (MLvalue);
	SetBfp (old);
	MLvalue -> exp_int = n;
	MLvalue -> exp_type = IsInteger;
    }
    GLeftS = LeftS;
    GLeftI = LeftI;
    return 1;
}

static
CompareReturn (val) {
    ReleaseExpr (MLvalue);
    if(GLeftS) free(GLeftS);
    MLvalue -> exp_type = IsInteger;
    MLvalue -> exp_int = val;
}

static
equal () {
    if (CompareSetup ())
	CompareReturn (GLeftS
		? strcmp (GLeftS, MLvalue -> exp_v.v_string) == 0
		: GLeftI == MLvalue -> exp_int);
    return 0;
}

static
notequal () {
    if (CompareSetup ())
	CompareReturn (GLeftS
		? strcmp (GLeftS, MLvalue -> exp_v.v_string) != 0
		: GLeftI != MLvalue -> exp_int);
    return 0;
}

static
less () {
    if (CompareSetup ())
	CompareReturn (GLeftS
		? strcmp (GLeftS, MLvalue -> exp_v.v_string) < 0
		: GLeftI < MLvalue -> exp_int);
    return 0;
}

static
lessequal () {
    if (CompareSetup ())
	CompareReturn (GLeftS
		? strcmp (GLeftS, MLvalue -> exp_v.v_string) <= 0
		: GLeftI <= MLvalue -> exp_int);
    return 0;
}

static
greater () {
    if (CompareSetup ())
	CompareReturn (GLeftS
		? strcmp (GLeftS, MLvalue -> exp_v.v_string) > 0
		: GLeftI > MLvalue -> exp_int);
    return 0;
}

static
GreaterEqual () {
    if (CompareSetup ())
	CompareReturn (GLeftS
		? strcmp (GLeftS, MLvalue -> exp_v.v_string) >= 0
		: GLeftI >= MLvalue -> exp_int);
    return 0;
}


static bitw_and () {
    register result = binsetup ();
    register i;
    for (i=2; !err && i <= CurExec->p_nargs; i++)
	result &= NumericArg(i);
    MLvalue -> exp_int = result;
    return 0;
}

static bitw_or () {
    register result = binsetup ();
    register i;
    for (i=2; !err && i <= CurExec->p_nargs; i++)
	result |= NumericArg(i);
    MLvalue -> exp_int = result;
    return 0;
}

static bitw_not () {
    MLvalue -> exp_int = ~NumericArg(1);
    return 0;
}

InitArith () {
    defproc (plus, "+");
    defproc (minus, "-");
    defproc (times, "*");
    defproc (divide, "/");
    defproc (mod, "%");
    defproc (shiftleft, "<<");
    defproc (shiftright, ">>");
    defproc (and, "&");
    defproc (or, "|");
    defproc (xor, "^");
    defproc (equal, "=");
    defproc (notequal, "!=");
    defproc (less, "<");
    defproc (lessequal, "<=");
    defproc (greater, ">");
    defproc (GreaterEqual, ">=");
    defproc (not, "!");
	defproc (bitw_and, "bitwise-and");
	defproc (bitw_or, "bitwise-or");
	defproc (bitw_not, "~");
}
arrows.c        508005730   1094  1000  100644  1245      `
/* mkc at paisley, 21 March 1984: define arrow keys from termcap */

#include "buffer.h"
#include "window.h"
#include "keyboard.h"


char *KUstr=0, *KDstr=0, *KLstr=0, *KRstr=0; /* set in TrmTERM.c */

InitArrows()
{
	arrowkey(KUstr,(Ctl('P')));
	arrowkey(KDstr,(Ctl('N')));
	arrowkey(KRstr,(Ctl('F')));
	arrowkey(KLstr,(Ctl('B')));
}

arrowkey(p,c)
register char *p;
register char c;
{
    register level;
    struct keymap *t= &GlobalMap;
    register struct keymap **tbl = &t;

    if (!p) return;
    level = strlen(p);
    while (--level >= 0) {
	if (*tbl == 0) {
	    register int    n;
	    *tbl = (struct keymap  *) malloc (sizeof **tbl);
	    if (tbl == &bf_mode.md_keys)
		bf_cur -> b_mode.md_keys = bf_mode.md_keys;
	    for (n = 0; n < 0200; n++)
		(*tbl) -> k_binding[n] = 0;
	}
	if (level>0 && ((*tbl)->k_binding[*p]==0
			|| (*tbl)->k_binding[*p]->b_binding != KeyBound)) {
	    register struct BoundName *nm =
		(struct BoundName *) malloc (sizeof (struct BoundName));
	    nm -> b_name = "BOGUS!";
	    nm -> b_binding = KeyBound;
	    nm -> b_bound.b_keymap = 0;
	    (*tbl) -> k_binding[*p] = nm;
	}
	if (level>0) tbl = &(*tbl)->k_binding[*p++]->b_bound.b_keymap;
    }
    (*tbl) -> k_binding[*p] = GlobalMap.k_binding[c];
}

bcpy.c          508005731   1094  1000  100644  514       `
	rbcopy(b1, b2, cnt)
			register unsigned char *b1, *b2;
			register int cnt;
		{
			if (0 < b2-b1 && b2-b1 < cnt) {
				b1 += cnt; b2 += cnt;
				while (cnt--) *b2-- = *b1--;
			} else
				while (cnt--) *b2++ = *b1++;
		}

cpyn(a,b,c)
int a;
char *b, *c;
{
bcopy(b,a,c);
}
/*
cpyn( from, to, size )
	char		*from,	*to;
	int		size;
{	if ( from >= to ) {
		for ( ; size > 0; size-- ) {
			*to++ = *from++;
		}
	}
	else {
		to   += size;
		from += size;
		for ( ; size > 0; size-- ) {
			*--to = *--from;
		}
	}
}
*/
buffer.c        509218498   1094  1000  100644  15275     `
/* Buffer manipulation primitives */

/*		Copyright (c) 1981,1980 James Gosling		*/

#include "config.h"
#include "buffer.h"
#include "window.h"
#include "syntax.h"
#include "abbrev.h"
#include "keyboard.h"
#include <sgtty.h>
#ifndef apm
#include "mchan.h"
#endif
#include "mlisp.h"

static char DefaultModeFormat[200];	/* User set mode line format */

/* The default values of several buffer-specific variables */
static int DefaultFoldCase;
static int DefaultRightMargin;
static int DefaultLeftMargin;
static int DefaultCommentColumn;
int DefaultTabSize;		/* Also used as an extern in mlisp.c */

extern char *malloc(), *realloc();

/* insert character c at positon n in the current buffer */
InsertAt (n, c)
register    n; {
    if (n != bf_s1 + 1)
	GapTo (n);
    if (bf_gap < 1)
	if(GapRoom (1)) return;
    if((bf_p1[++bf_s1] = c) == '\n') Cant1LineOpt++;
    bf_gap--;
    bf_p2--;
    RecordInsert (n, 1);
    if (bf_modified==0) Cant1LineOpt++;
    bf_modified++;
}

/* Insert the N character string S at dot. */
InsCStr (s, n)
register    n;
register char  *s; {
int en = n;
char *es = s;
    if (dot != bf_s1 + 1)
	GapTo (dot);
    if (bf_gap < n)
	if(GapRoom (n)) return;
    RecordInsert (dot, n);
    while (/* *s && */ --n >= 0) {
	if (bf_gap <= 0) {
fprintf(stderr, "InsCStr gap overrun: n = %d, s = %s\n", en, es);
	    error ("InsCStr gap overrun!");
	    break;
	}
	if ((bf_p1[++bf_s1] = *s++) == '\n')
	    Cant1LineOpt++;
	bf_gap--;
	DotRight (1);
	bf_p2--;
    }
    if (bf_modified==0) Cant1LineOpt++;
    bf_modified++;
}

/* delete k characters forward from position n in the current
   buffer */
DelFrwd (n, k)
register    n; {
    if (n != bf_s1 + 1)
	GapTo (n);
    if (k > bf_s2 - bf_mode.md_TailClip)
	k = bf_s2 - bf_mode.md_TailClip;
    if (k > 0) {
	bf_gap += k;
	RecordDelete (n, k);
	if (n != dot || k > 1 || CharAt (n) == '\n')
	    Cant1LineOpt++;
	if (bf_modified == 0)
	    Cant1LineOpt++;
	bf_modified++;
	bf_s2 -= k;
	bf_p2 += k;
	{			/* adjust markers */
	    register struct marker *m;
	    register    lim = bf_s1 + bf_gap;
	    for (m = bf_cur -> b_markset; m; m = m -> m_next)
		if (m -> m_pos > bf_s1 && m -> m_pos <= lim) {
		    m -> m_pos = bf_s1 + 1;
		    m -> m_modified++;
		}
	}
    }
}

/* delete k characters backward from position n in the current
   buffer */
DelBack (n, k)
register    n; {
    if (n != bf_s1 + 1)
	GapTo (n);
    if (k > bf_s1 - bf_mode.md_HeadClip + 1)
	k = bf_s1 - bf_mode.md_HeadClip + 1;
    if (k > 0) {
	if (n != dot || k > 1 || CharAt (n - 1) == '\n')
	    Cant1LineOpt++;
	bf_gap += k;
	RecordDelete (n-k, k);
	if (bf_modified == 0)
	    Cant1LineOpt++;
	bf_modified++;
	bf_p2 += k;
	bf_s1 -= k;
	{			/* adjust markers */
	    register struct marker *m;
	    register    lim = bf_s1 + bf_gap;
	    for (m = bf_cur -> b_markset; m; m = m -> m_next)
		if (m -> m_pos > bf_s1 && m -> m_pos <= lim) {
		    m -> m_pos = bf_s1 + 1;
		    m -> m_modified++;
		}
	}
    }
}

/* move the gap to position n */
GapTo (n) {
    register char  *p1,
                   *p2,
                   *lim;
    register    delt;
    int     old_s1 = bf_s1;
    register struct marker *m = bf_cur -> b_markset;

    if (n < 0)
	n = 0;
    if (n > bf_s1 + bf_s2)
	n = bf_s1 + bf_s2 + 1;
    if (n == bf_s1 + 1)
	return;
    if (n <= bf_s1) {		/* moving the gap left (into the first
				   part) */
/*	p1 = bf_p1+1 + bf_s1 + bf_gap; */
	p2 = bf_p1 + 1 + bf_s1;
	p1 = p2 + bf_gap;
	lim = bf_p1 + n;
	delt = p2 - lim;
	while (p2 > lim)
	    *--p1 = *--p2;
	bf_s1 -= delt;
	bf_s2 += delt;
	while (m) {		/* adjust markers */
	    if (m -> m_pos > old_s1) {
		if (m -> m_pos <= old_s1 + bf_gap){
		    m -> m_pos = old_s1 + bf_gap + 1;
		    m -> m_modified++;
		}
	    }
	    else
		if (m -> m_pos > bf_s1+1){
		    m -> m_pos += bf_gap;
		    m->m_modified++;
		}
	    m = m -> m_next;
	}
    }
    else {			/* moving the gap right (into the second
				   part) */
	p1 = bf_p1 + 1 + bf_s1;
	p2 = p1 + bf_gap;
	lim = bf_p2 + n;
	delt = p2 - lim;	/* delt<0 */
	while (p2 < lim)
	    *p1++ = *p2++;
	bf_s1 -= delt;
	bf_s2 += delt;
	while (m) {		/* adjust markers */
	    if (m -> m_pos > old_s1 && m -> m_pos <= bf_s1 + bf_gap + 1){
		if (m -> m_pos > old_s1 + bf_gap)
		    m -> m_pos -= bf_gap;
		else
		    m -> m_pos = old_s1 + 1;
		m->m_modified++;
	    }
	    m = m -> m_next;
	}
    }
}

/* make sure that the gap in the current buffer is at least k
   characters wide */
GapRoom (k) {
    register struct buffer *b = bf_cur;
/*
    register char  *p1,
                   *p2,
                   *lim;
*/
    register struct marker *m;
    register    old_gap;
    if (bf_gap >= k)
	return 0;
    old_gap = bf_gap;
    b -> b_size += k + 2000;
    if (b -> b_base)
	b -> b_base = (char *) realloc (b -> b_base, b -> b_size);
    if (b -> b_base == 0){
	bf_p1 = bf_p2 = (char *) -1;
	b -> b_size = b -> b_gap = bf_gap = bf_s1 = bf_s2 = 0;
	error ("Out of memory!  Lost buffer %s", b -> b_name);
	return 1;
    }
    bf_p1 = b -> b_base - 1;
/*
    p1 = b -> b_base + b -> b_size;
    p2 = b -> b_base + bf_s1 + bf_s2 + bf_gap;
    lim = b -> b_base + bf_s1 + bf_gap;
    bf_gap += p1 - p2;
    while (lim < p2)
	*--p1 = *--p2;
*/
    bcopy (b->b_base + bf_s1 + bf_gap, b->b_base + b->b_size - bf_s2, bf_s2);
    bf_gap = b -> b_size - bf_s1 - bf_s2;

    bf_p2 = bf_p1 + bf_gap;
    for (m = b -> b_markset; m; m = m -> m_next)
	if (m -> m_pos > bf_s1 + old_gap){
	    m -> m_pos += bf_gap - old_gap;
	    m -> m_modified++;
	}
    return 0;
}

/* create a buffer with the given name */
struct buffer   *NewBf (name)
char   *name; {
    register struct buffer *b = (struct buffer *) malloc (sizeof *b);
    b -> b_size = 2000;
    b -> b_base = (char *) malloc (b -> b_size);
    if (b -> b_base == 0)
	b -> b_size = 0;	/* out of memory -- give the error message
				   when we try to enlarge the buffer */
    b -> b_name = savestr (name);
    b -> b_fname = 0;
    b -> b_kind = ScratchBuffer;
    b -> b_modified = 0;
    b -> b_BackedUp = 0;
    b -> b_EphemeralDot = 1;
    b -> b_checkpointed = 0;
    b -> b_checkpointfn = 0;
    b -> b_size1 = b -> b_size2 = 0;
    b -> b_gap = b -> b_size;
    b -> b_next = buffers;
    b -> b_markset = 0;
    b -> b_mark = 0;
    b -> b_mode.md_keys = 0;
    strcpy (b -> b_mode.md_ModeString, "Normal");
    b -> b_mode.md_PrefixString[0] = 0;
    b -> b_mode.md_abbrev = 0;
    b -> b_mode.md_TailClip = 0;
    b -> b_mode.md_HeadClip = 1;
    b -> b_mode.md_syntax = &GlobalSyntaxTable;
    b -> b_mode.md_AbbrevOn = GlobalAbbrev.a_NumberDefined > 0;
    strcpy (b -> b_mode.md_ModeFormat, DefaultModeFormat);
    b -> b_AutoFillHook = 0;
    b -> b_mode.md_FoldCase = DefaultFoldCase;
    b -> b_mode.md_RightMargin = DefaultRightMargin;
    b -> b_mode.md_LeftMargin = DefaultLeftMargin;
    b -> b_mode.md_CommentColumn = DefaultCommentColumn;
    b -> b_mode.md_TabSize = DefaultTabSize;
    b -> b_mode.md_NeedsCheckpointing = 1;
    b -> b_mode.md_ReadOnly = 0;
    buffers = b;
/* DJH -- Store buffer name in BufNames; realloc if necessary */
    BufNames[NBuffers++] = b -> b_name;
    if (--BufNameFree == 0) {
	BufNames = (char **) realloc(BufNames,2 * NBuffers * sizeof(char *));
	BufNameFree = NBuffers;
    }
    BufNames[NBuffers] = 0;
    return b;
}

/* Delete the given buffer */
DelBuf (b)
register struct buffer *b;
{
    register struct window *w;
    register struct buffer *p;
    if (b == 0 || b -> b_kind == DeletedBuffer)
	return;
#ifdef subprocesses
    {
	register struct process_blk *proc;
	for (proc = process_list; proc; proc = proc -> next_process)
	    if (b == proc -> p_chan.ch_buffer) 
	    	if (proc -> p_flag & (EXITED | SIGNALED))
		    flush_process (proc);
		else {
		    error ("There is a process attached to buffer %s, so I can't delete it",
			b -> b_name);
		    return;
	        }
    }
#endif
    DeleteBuffersCheckpointFile (b);
    b -> b_kind = DeletedBuffer;
    {
	register int    i;
	for (i = 0; i < NBuffers; i++)
	    if (b -> b_name == BufNames[i]) {
		BufNames[i] = BufNames[--NBuffers];
		BufNames[NBuffers] = 0;
		break;
	    }
    }
    for (w = windows; w; w = w -> w_next)
	if (w -> w_buf == b)
	    DelWin (w);
    if (buffers == b)
	buffers = b -> b_next;
    for (p = buffers; p; p = p -> b_next)
	if (p -> b_next == b) {
	    p -> b_next = b -> b_next;
	    break;
	}
    if (b -> b_base)
	free (b -> b_base);
    b -> b_base = 0;
    b -> b_size = b -> b_size1 = b -> b_size2 = b -> b_gap = 0;
    if (wn_cur -> w_buf == b) {
	for (p = buffers; p; p = p -> b_next)
	    if (p -> b_kind == FileBuffer)
		break;
	if (p == 0)
	    p = buffers;
	if (p == 0 || p == minibuf)
	    p = NewBf ("main");
	TieWin (wn_cur, p);
    }
    if (wn_cur -> w_buf != bf_cur)
	SetBfp (wn_cur -> w_buf);
}

/* find a buffer with the given name -- returns nil if no such
   buffer exists */
struct buffer *FindBf(name)
register char   *name; {
    register struct buffer *b = buffers;
    while (b && strcmp (name, b -> b_name) != 0)
	b = b -> b_next;
    return b;
}

/* set the current buffer to p */
SetBfp (p)
register struct buffer *p; {
    register struct buffer *c = bf_cur;
    register struct window *w = wn_cur;
    if (p && p -> b_kind == DeletedBuffer)
	return;
    Cant1WinOpt++;
    if (c) {
	if (w && c == w -> w_buf)
	    SetMark (w -> w_dot, c, dot);
	c -> b_size1 = bf_s1;
	if (c -> b_modified != bf_modified) {
	    c -> b_modified = bf_modified;
	    Cant1LineOpt++;
	}
	c -> b_size2 = bf_s2;
	c -> b_gap = bf_gap;
	c -> b_EphemeralDot = dot;
    }
    bf_cur = p;
    bf_modified = p -> b_modified;
    bf_mode = p -> b_mode;
    bf_s1 = p -> b_size1;
    bf_s2 = p -> b_size2;
    bf_gap = p -> b_gap;
    bf_p1 = p -> b_base - 1;
    bf_p2 = bf_p1 + bf_gap;
    SetDot (w && p == w -> w_buf ? ToMark (w -> w_dot) : p -> b_EphemeralDot);
}

/* set the current buffer to the one named */
SetBfn (name)
char   *name; {
    register struct buffer *p;
    if(name==0) return 0;
    p = FindBf (name);
    if (p == 0)
	p = NewBf (name);
    SetBfp (p);
    return 0;
}

/* Erase the contents of a buffer */
EraseBf (b)
register struct buffer *b; {
    register struct buffer *old = bf_cur;
    SetBfp (b);
    DelFrwd (FirstCharacter, NumCharacters-FirstCharacter+1);
    SetDot (FirstCharacter);
    Cant1LineOpt++;
    bf_modified = 0;
    SetBfp (old);
}

/* Rename a buffer */
RenameBf (b, new)
register struct buffer *b;
register char *new;
{
    register n = 0;
    register char *old = b -> b_name;
    if (!new || !*new) {
	error ("Invalid buffer name");
	return 1;
    }
    if (FindBf (new)) {
	error ("Buffer name \"%s\" is in use",new);
	return 1;
    }
    while (n < NBuffers && strcmp (BufNames[n], old))
	++n;
    if (n >= NBuffers)			/* "Can't happen" */
	return -1;
    free (old);
    b -> b_name = BufNames[n] = savestr (new);
    return 0;
}

/* initialize the buffer routines */
Initbf () {			/* (DJH) allocate buffer list */
#ifdef DumpableEmacs
    if (!Once)
#endif
    {
    	DefaultTabSize = 8;
    	BufNames = (char **) malloc( (BufNameFree = 10) * sizeof(char *) );
    	NBuffers = 0;
    	DefStrVar ("default-mode-line-format", DefaultModeFormat);
    	DefStrVar ("mode-line-format", bf_mode.md_ModeFormat);
    	SetSysDefault;
    	strcpy (DefaultModeFormat, " %[Buffer: %b%*  File: %f  %M (%m)  %p%]");
    	SetBfn ("  Minibuf");
    	minibuf = bf_cur;
    	SetBfn ("main");
    	minibuf -> b_mode.md_NeedsCheckpointing = 0;
    	bf_cur -> b_kind = FileBuffer;
    	DefIntVar ("default-case-fold-search", &DefaultFoldCase);
    	DefIntVar ("case-fold-search", &bf_mode.md_FoldCase);
    	SetSysDefault;
    	DefStrVar ("mode-string", bf_mode.md_ModeString);
    	DefIntVar ("buffer-is-modified", &bf_modified);
    	DefaultFoldCase = 0;
    	DefIntVar ("default-right-margin", &DefaultRightMargin);
    	DefIntVar ("right-margin", &bf_mode.md_RightMargin);
    	SetSysDefault;
    	DefaultRightMargin = 10000;
    	DefIntVar ("default-left-margin", &DefaultLeftMargin);
    	DefIntVar ("left-margin", &bf_mode.md_LeftMargin);
    	SetSysDefault;
    	DefaultLeftMargin = 1;
    	DefIntVar ("default-comment-column", &DefaultCommentColumn);
    	DefIntVar ("comment-column", &bf_mode.md_CommentColumn);
    	SetSysDefault;
    	DefaultCommentColumn = 33;
    	DefIntVar ("default-tab-size", &DefaultTabSize);
    	DefIntVar ("tab-size", &bf_mode.md_TabSize);
    	SetSysDefault;
    	DefIntVar ("needs-checkpointing", &bf_mode.md_NeedsCheckpointing);
    	DefIntVar ("abbrev-mode", &bf_mode.md_AbbrevOn);
    	DefStrVar ("prefix-string", bf_mode.md_PrefixString);
    }
}

/* save a string in managed memory */
char *savestr(s)
char *s; {
    char *ret;
    ret = (char *) malloc (strlen (s) + 1);
    strcpy (ret, s);
    return ret;
}

/* Marker routines */

/* create a new marker */
struct marker  *NewMark () {
    register struct marker *m
	= (struct marker *) malloc (sizeof (struct marker));
    m -> m_buf = 0;
    m -> m_pos = 0;
    m -> m_modified = 0;
    m -> m_next = 0;
    m -> m_prev = 0;
    return m;
}

/* delink a marker from a list of markers */
static  DelinkMark (m)
register struct marker *m; {
    if (m == 0 || m -> m_buf == 0)
	return;
    if (m -> m_prev)
	m -> m_prev -> m_next = m -> m_next;
    else
	m -> m_buf -> b_markset = m -> m_next;
    if (m -> m_next)
	m -> m_next -> m_prev = m -> m_prev;
}

/* destroy a marker */
DestMark (m)
register struct marker *m; {
    if (m == 0)
	return;
    DelinkMark (m);
    free (m);
}

/* set marker m in buffer b at position p */
SetMark (m, b, p)
register struct marker *m;
register struct buffer *b; {
    if (m == 0) {
	error ("Unitialized marker!");
	return;
    }
    DelinkMark (m);
    if(p<1) error("Bogus Setmark to %d", p), p = 1;
    m -> m_buf = b;
    m -> m_modified = 0;
    m -> m_next = b -> b_markset;
    m -> m_prev = 0;
    if (m -> m_next)
	m -> m_next -> m_prev = m;
    b -> b_markset = m;
    m -> m_modified = 0;
    m -> m_pos = p;
    if (b == bf_cur) {
	if (p > bf_s1+1)
	    m -> m_pos += bf_gap;
    }
    else
	if (p > b -> b_size1+1)
	    m -> m_pos += b -> b_gap;
}

/* copy the value of the source marker to the destination, handling all the
   nasty linking and delinking */
struct marker *
CopyMark (dst, src)
register struct marker *dst, *src;
{
    SetMark (dst, src -> m_buf, 1);
    dst -> m_pos = src -> m_pos;
    return dst;
}

/* set bf_cur to the buffer indicated by the given marker and return
   the position ("dot" value) within that buffer; returns 0 iff the
   marker wasn't set. */
ToMark (m)
register struct marker *m; {
    if (m == 0 || m -> m_buf == 0)
	return 0;
    if (bf_cur != m -> m_buf)
	SetBfp (m -> m_buf);
    if (m -> m_pos <= bf_s1)
	return m -> m_pos;
    if (m -> m_pos <= bf_s1 + bf_gap)
	return bf_s1 + 1;
    return m -> m_pos - bf_gap;
}

/* return the positional value of a marker in a buffer without changing
   buffers. Return 0 iff marker not set */

MarkerValue (m)
register struct marker *m; {
    register struct buffer *old = bf_cur;
    register rv;
    if (m == 0 || m -> m_buf == 0)
    	return 0;
    if (bf_cur != m-> m_buf)
    	SetBfp (m -> m_buf);
    rv = m -> m_pos <= bf_s1		? m -> m_pos :
	m -> m_pos <= bf_s1 + bf_gap	? bf_s1 + 1  :
					  m -> m_pos - bf_gap;
    SetBfp (old);
    return rv;
}

casefiddle.c    508005721   1094  1000  100644  2465      `
/* emacs routines to play with the case of words (invert; set upper; set
   lower; capitalize) */

/*		Copyright (c) 1981,1980 James Gosling		*/

#include "buffer.h"
#include "keyboard.h"
#include "window.h"
#include "syntax.h"
#include <ctype.h>

/* Perform a case translation on the region from character "first" to
   character "last".
	mode=0 => invert
	mode=1 => upper
	mode=2 => lower
	mode=3 => capitalize (upper case first letter; lower case rest)
 */
CaseFiddle (first, last, mode)
register	first,
		last,
mode; {
    register char  *p;
    register    firstlet = 1;
    while (first < last) {
	p = &CharAt (first);
	first++;
	if (!CharIs (*p, WordChar)) {
	    firstlet = 1;
	}
	else {
	    if (isalpha (*p))
		if (mode == 0 ||
			(isupper (*p) ? mode == 2 || mode == 3 && !firstlet
			    : mode == 1 || mode == 3 && firstlet)) {
		    InsertAt (first-1, *p ^ 040);
		    DelFrwd (first, 1);
		}
	    firstlet = 0;
	}
    }
    bf_modified++;
}

CaseWord (mode) {
    register    olddot = dot;
    register    left = arg;
    if(dot<=NumCharacters) DotRight(1);
    arg = 1;
    BackwardWord ();
    Cant1LineOpt++;
    arg = left;
    left = dot;
    ForwardWord ();
    CaseFiddle (left, dot, mode);
    SetDot (olddot);
}

CaseRegion (mode) {
    register    left,
                right = dot;
    if (bf_cur -> b_mark == 0)
	error ("Mark not set.");
    else {
	left = ToMark (bf_cur -> b_mark);
	if (left > right)
	    right = left, left = dot;
	CaseFiddle (left, right, mode);
    }
}

CaseWordInvert () {
    CaseWord (0);
    return 0;
}

CaseWordUpper () {
    CaseWord (1);
    return 0;
}

CaseWordLower () {
    CaseWord (2);
    return 0;
}

CaseWordCapitalize () {
    CaseWord (3);
    return 0;
}

CaseRegionInvert () {
    CaseRegion (0);
    return 0;
}

CaseRegionUpper () {
    CaseRegion (1);
    return 0;
}

CaseRegionLower () {
    CaseRegion (2);
    return 0;
}

CaseRegionCapitalize () {
    CaseRegion (3);
    return 0;
}

InitCase () {
    setkey (ESCmap, ('^'), CaseWordInvert, "case-word-invert");
    setkey (ESCmap, ('u'), CaseWordUpper, "case-word-upper");
    setkey (ESCmap, ('l'), CaseWordLower, "case-word-lower");
    defproc (CaseWordCapitalize, "case-word-capitalize");
    setkey (ESCmap, (Ctl ('^')), CaseRegionInvert, "case-region-invert");
    defproc (CaseRegionUpper, "case-region-upper");
    defproc (CaseRegionLower, "case-region-lower");
    defproc (CaseRegionCapitalize, "case-region-capitalize");
}

columns.c       508005721   1094  1000  100644  1339      `
/* Routines to deal with column numbering */

/*		Copyright (c) 1981,1980 James Gosling		*/

#include "window.h"
#include "buffer.h"

/* calculate the print column at dot */
CalcCol () {
    register    p = ScanBf ('\n', dot, -1);
    register    col = 1;
    while (p < dot) {
	register char   c = CharAt (p);
	if (c == 011)
	    col = ((col - 1) / bf_mode.md_TabSize + 1)
			* bf_mode.md_TabSize + 1;
	else
	    if (c < 040 || c >= 0177)
		col += CtlArrow ? 2 : 4;
	    else
		col += 1;
	p++;
    }
    DotCol = col;
    ColValid++;
    return col;
}

/* Insert tabs and spaces until we're out to at least column n */
ToCol (n) {
    register    col = CurCol;
    register    ncol;
    if (col >= n)
	return;
    while ((ncol = ((col - 1) / bf_mode.md_TabSize + 1) * bf_mode.md_TabSize + 1) <= n) {
	SelfInsert ('\t');
	col = ncol;
    }
    while (col < n) {
	SelfInsert (' ');
	col++;
    }
    DotCol = col;
    ColValid = 1;
}

/* Calculate the indentation of the current line */
CurIndent () {
    register    p = ScanBf ('\n', dot, -1);
    register    col = 1;
    register lim = NumCharacters;
    while (p <= lim) {
	register char   c = CharAt (p);
	if (c == 011)
	    col = ((col - 1) / bf_mode.md_TabSize + 1)
				* bf_mode.md_TabSize + 1;
	else
	    if (c == 040)
		col += 1;
	    else
		break;
	p++;
    }
    return col;
}

dbmanager.c     508005721   1094  1000  100644  5471      `
/* Simple data base manager routines, styled after the dbm routines that came
   with Unix V7 (it uses a much modified version of them) */

/*		Copyright (c) 1981 James Gosling		*/

#include "buffer.h"
#include "config.h"
#include "window.h"
#include "keyboard.h"
#include "ndbm.h"
#define SearchLen 10		/* maximum number of components in a database
				   search list */

struct dbsearch {		/* a database search list */
    int dbs_size;			/* number of components */
    struct dbsearch *dbs_next;	/* the next search list */
    char *dbs_name;		/* the name of this search list */
    database *dbs[SearchLen];	/* the components -- each is a database from
				   the ndbms package */
};

static struct dbsearch *dbroot;	/* the root of the list of database search
				   lists */

/* find a named search list */
static struct dbsearch *FindSL(name)
char   *name; {
    register struct dbsearch   *p;
    for (p = dbroot; p; p = p->dbs_next)
	if (strcmp (p -> dbs_name, name) == 0)
	    return p;
    return 0;
}

/* define a named search list (extend-database-search-list name content) */
static  ExtendDatabaseSearchList () {
    char   *name,
           *content;
    register struct dbsearch   *p;
    register i;
    name = getnbstr (": extend-database-search-list (name) ");
    if (name == 0)
	return 0;
    p = FindSL (name);
    if (p == 0) {
	p = (struct dbsearch   *) malloc (sizeof *p);
	p -> dbs_name = savestr (name);
	p -> dbs_next = dbroot;
	dbroot = p;
	p -> dbs_size = 0;
    }
    content = getnbstr (": extend-database-search-list (name) %s (dbname) ",
	    p -> dbs_name);
    if (content == 0)
	return 0;
    content = (char *) SaveAbs (content);
    for (i = 0; i < p -> dbs_size; i++)
	if (strcmp (content, p -> dbs[i] -> dbnm) == 0)
	    return 0;
    if (p -> dbs_size == SearchLen) {
	error ("Too many components in search list");
	return 0;
    }
    {
	register    database * db = open_db (content);
	if (db == 0)
	    error ("Can't find database \"%s\"", content);
	else {
	    for (i = p -> dbs_size; i > 0; i--)
		p -> dbs[i] = p -> dbs[i - 1];
	    p -> dbs[0] = db;
	    p -> dbs_size++;
	}
    }
    return 0;
}

/* function for inserting text into a buffer -- given a size returns a
   pointer to a region of size characters */
static char *InsertionFunc (n) {
            GapTo (dot);
    if (GapRoom (n))
	return 0;
    DoneIsDone ();
    if (n > 0) {
	bf_s1 += n;
	bf_gap -= n;
	bf_p2 -= n;
    }
    bf_modified++;
    return & CharAt (dot);
}

/* fetch an entry from a database into the current buffer
   (fetch-database-entry dbname key) */
static  FetchDatabaseEntry () {
    char   *dbname = getnbstr (": fetch-database-entry (database) ");
    register struct dbsearch   *dbs;
    register int    i;
    char   *key,
           *content;
    int     keylen,
            contentlen;
    if (dbname == 0)
	return 0;
    dbs = FindSL (dbname);
    if (dbs == 0) {
	error ("No such database search list defined");
	return 0;
    }
    key = getnbstr (": fetch-database-entry (database) %s (key) ",
	    dbs -> dbs_name);
    keylen = strlen (key);
    for (i = 0; i < dbs -> dbs_size; i++)
	if (get_db (key, keylen,
		    &content, &contentlen,
		    InsertionFunc, dbs -> dbs[i]) == 0)
	    break;
    Cant1LineOpt++;
    if (i >= dbs -> dbs_size)
	error ("Entry not found.");
    return 0;
}

/* Put the contents of the current buffer into a database
   (put-database-entry database key) */
static  PutDatabaseEntry () {
    char   *dbname = getnbstr (": put-database-entry (database) ");
    register struct dbsearch   *dbs;
    register int    i,
                    slot;
    int     keylen;
    int     contentlen;
    char   *key,
           *content;
    if (dbname == 0)
	return 0;
    dbs = FindSL (dbname);
    if (dbs == 0) {
	error ("No such database search list defined");
	return 0;
    }
    key = getnbstr (": put-database-entry (database) %s (key) ",
	    dbs -> dbs_name);
    keylen = strlen (key);
    GapTo (bf_s1 + bf_s2 + 1);
    slot = -1;
    for (i = 0; i < dbs -> dbs_size; i++)
	if (!dbs -> dbs[i] -> dbrdonly)
	    if (get_db (key, keylen, 0, 0, 0, dbs -> dbs[i])) {
		slot = i;
		break;
	    }
	    else
		if (slot < 0)
		    slot = i;
    if (slot < 0) {
	error ("%s is a read-only database.", dbs -> dbs_name);
	return 0;
    }
    if (put_db (key, strlen (key),
		&CharAt (1), bf_s1 + bf_s2,
		dbs -> dbs[slot]) < 0)
	error ("Database put failed -- probably a fatal key collision");
    return 0;
}

/* List the names and contents of all database search lists */
static  ListDatabases () {
    register struct dbsearch   *p;
    register    i;
    register struct buffer *old = bf_cur;
    SetBfn ("Database list");
    if (interactive)
	WindowOn (bf_cur);
    EraseBf (bf_cur);
    for (p = dbroot; p; p = p -> dbs_next) {
	char    buf[MaxPathNameLen];
	InsStr (sprintfl (buf, sizeof buf, "%s:\n", p -> dbs_name));
	for (i = 0; i < p -> dbs_size; i++) {
	    register    database * db = p -> dbs[i];
	    InsStr (sprintfl (buf, sizeof buf, "    %s%s\n", db -> dbnm,
			     db -> dbrdonly ? "   (read only)" : ""));
	}
    }
    bf_cur -> b_mode.md_NeedsCheckpointing = 0;
    bf_modified = 0;
    SetBfp (old);
    WindowOn (bf_cur);
    return 0;
}

InitDb () {
    defproc (ExtendDatabaseSearchList, "extend-database-search-list");
    defproc (FetchDatabaseEntry, "fetch-database-entry");
    defproc (PutDatabaseEntry, "put-database-entry");
    defproc (ListDatabases, "list-databases");
}

display.c       509113840   1094  1000  100644  27243     `
/* Ultra-hot screen management package
  		James Gosling, January 1980			*/

/* Simplified the update algorithm for use with fast terminals
   and slow CPU's.  Frank Cringle, January 1986			*/

/*		Copyright (c) 1981,1980 James Gosling		*/

/****************************************************************



			 /-------------\
			/		\
		       /		 \
		      /			  \
		      |	  XXXX	   XXXX	  |
		      |	  XXXX	   XXXX	  |
		      |	  XXX	    XXX	  |
		      \		X	  /
		       --\     XXX     /--
			| |    XXX    | |
			| |	      | |
			| I I I I I I I |
			|  I I I I I I	|
			 \	       /
			  --	     --
			    \-------/
		    XXX			   XXX
		   XXXXX		  XXXXX
		   XXXXXXXXX	     XXXXXXXXXX
			  XXXXX	  XXXXX
			     XXXXXXX
			  XXXXX	  XXXXX
		   XXXXXXXXX	     XXXXXXXXXX
		   XXXXX		  XXXXX
		    XXX			   XXX

			  **************
			  *  BEWARE!!  *
			  **************

			All ye who enter here:
		    Most of the code in this module
		       is twisted beyond belief!

			   Tread carefully.

		    If you think you understand it,
			      You Don't,
			    So Look Again.

 ****************************************************************/

/* DJH -- Added Ding() for bell */


#include "display.h"
#include "window.h"
#include "keyboard.h"
#include "mlisp.h"
#include <sgtty.h>

#ifdef apm
#define IPEND(n)	(n = ipend())
#define SLOWCPU
#else
#ifdef FIONREAD
#define IPEND(n)	(ioctl(fileno(stdin), FIONREAD, &n))
#endif
#endif

/* the following macros are used to access terminal specific routines.
   Really, no one outside of display.c should be using them, except for
   the initialize/cleanup routines */
#define topos (*tt.t_topos)
#define reset (*tt.t_reset)
#define INSmode (*tt.t_INSmode)
#define insertlines (*tt.t_inslines)
#define deletelines (*tt.t_dellines)
#define blanks (*tt.t_blanks)
#define wipeline (*tt.t_wipeline)
#define wipescreen (*tt.t_wipescreen)
#define deletechars (*tt.t_delchars)
#define dumpstring (*tt.t_writechars)

#define MScreenWidth 135
#define MScreenLength 70
#define min(a,b) (a<b ? a : b)
#define max(a,b) (a>b ? a : b)
#define abs(a)	 (((a) > 0) ? (a) : -(a))
#define hidden static
#ifdef apm
#define bighidden
#else
#define bighidden static
#endif
#define visible
#define procedure
#define function

bighidden struct {
    int     HLbody[MScreenWidth + 1];/* bitmap with ones for all those
				   positions that should be highlighted 
				*/
    int     applied;
}               newhighlights, oldhighlights;

hidden struct line {		/* a line as it appears in a list of
				   lines (as in the physical and virtual
				   display lists) */
    int     hash;		/* hash value for this line, 0 if not
				   known */
    struct line *next;		/* pointer to the next line in a list of
				   lines */
    short   DrawCost;		/* the cost of redrawing this line */
    short   length;		/* the number of valid characters in the
				   line */
    char    highlighted;	/* true iff this line is to be
				   highlighted */
    char    body[MScreenWidth];	/* the actual text of the line */
}
                   *FreeLines,	/* free space list */
                   *NLScratch;	/* scratch for use by the newline macro 
				*/

hidden WindowSize;		/* the number of lines on which line ID
				   operations should be done */
int baud_rate;			/* Terminal speed, so we can calculate
				   the number of characters required to
				   make the cursor sit still for n secs. */
hidden CheckForInput;		/* -ve iff UpdateLine should bother
				   checking for input */

/* 'newline' returns a pointer to a new line object, either from the
   free list or from the general unix pool */
struct line *newline () {
    register struct line   *p = FreeLines;

    if (p) {
	FreeLines = p -> next;
	if (p -> hash != 12345) {
	    FreeLines = 0;
#ifdef DEBUG
	    register FILE *f = fopen ("EMACS_TRACE", "w");
	    topos (23, 1);
	    vprintf ("*****Bogus value in display free list");
	    if (f) {
		register int *p1 = ((int *) p) - 10;
		register char *p2 = (char *) p1;
		register i;
		fprintf (f, "Bogus value in display free list at %o\n", p);
		for (i=0; i<25; i++) {
		    fprintf (f, "%11o: %011o %9d  %03o %03o %03o %03o\n",
				p1, *p1, *p1,
				p2[0], p2[1], p2[2], p2[3]);
		    p1++; p2 += 4;
		}
		fclose (f);
	    }
#endif
	    return newline ();
	}
    }
    else {
	static Leakage;
	extern char *malloc();
	p = (struct line   *) malloc (sizeof *p);
	if (++Leakage>150) vprintf ("*****Display core leakage!");
    }
    p -> length = 0;
    p -> hash = 0;
    p -> highlighted = 0;
    return p;
}

/* 'ReleaseLine' returns a line object to the free list */
hidden procedure ReleaseLine (p)
register struct line   *p; {
    if (p) {
	if (p -> hash == 12345) {
	    vprintf("\rBogus re-release!");
	    fflush(stdout);
	    /* abort(); */
	    return;
	}
	p -> next = FreeLines;
	p -> hash = 12345;
	FreeLines = p;
    }
}

bighidden struct line *PhysScreen[MScreenLength + 1];
 /* the current (physical) screen */
bighidden struct line *DesiredScreen[MScreenLength + 1];
 /* the desired (virtual) screen */

visible int
            ScreenGarbaged,	/* set to 1 iff screen content is
				   uncertain. */
            RDdebug,		/* line redraw debug switch */
            IDdebug,		/* line insertion/deletion debug */
            cursX,		/* X and Y coordinates of the cursor */
            cursY,		/* between updates. */
            CurrentLine,	/* current line for writing to the
				   virtual screen. */
            left;		/* number of columns left on the current
				   line of the virtual screen. */
visible char
               *cursor;		/* pointer into a line object, indicates
				   where to put the next character */


/* 'setpos' positions the cursor at position (row,col) in the virtual
   screen */
visible procedure setpos (row, col)
register    row,
            col; {
    register struct line   *p;
    register    n;

    if (CurrentLine >= 0
	    && (p = DesiredScreen[CurrentLine]) -> length
	    <= (n = ScreenWidth - left))
	p -> length = left > 0 ? n : ScreenWidth;
    if (!DesiredScreen[row])
	DesiredScreen[row] = newline ();
    (p = DesiredScreen[row]) -> hash = 0;
    while (p -> length + 1 < col)
	p -> body[p -> length++] = ' ';
    CurrentLine = row;
    left = ScreenWidth + 1 - col;
    cursor = &DesiredScreen[row] -> body[col - 1];
}

/* 'clearline' positions the cursor at the beginning of the
   indicated line and clears the line (in the image) */
clearline (row) {
    setpos (row, 1);
    DesiredScreen[row] -> length = 0;
}

/* 'HighLine' causes the current line to be highlighted */
HighLine () {
    if (CurrentLine >= 0)
	DesiredScreen[CurrentLine] -> highlighted++;
}

/* 'hashline' computes a hash value for a line, unless the hash value
   is already known.  This hash code has a few important properties:
	- it is independant of the number of leading and trailing spaces
	- it will never be zero
 
   As a side effect, an estimate of the cost of redrawing the line is
   calculated */
hidden procedure hashline (p)
register struct line   *p; {
    register char  *c,
                   *l;
    register    h;

    if (!p || p -> hash) {
	if (p && p->hash==12345) vprintf ("****Free line in screen");
	return;
    }
    h = 0;
    c = p -> body;
    l = &p -> body[p -> length];
    while (--l > c && *l == ' ');
    while (c <= l && *c == ' ')
	c++;
    p -> DrawCost = l - c + 1;
    if (p -> highlighted) {
	p -> hash = -200;
	return;
    }
    while (c <= l)
	h = (h << 5) + h + *c++;
    p -> hash = h!=12345 && h ? h : 1;
}

#ifdef SLOWCPU
bighidden int PhysHash[MScreenLength], DesiredHash[MScreenLength];

hidden int function QuickHash()
/* build a quickly accessible copy of the desired and actual hash values */
{
	register int c, i;
	register int *Ph = PhysHash + 1;
	register int *Dh = DesiredHash + 1;

	for (i = 1, c = 0; i <= ScreenLength; i++) {
		*Ph = (PhysScreen[i]) ? PhysScreen[i]->hash : 0;
		*Dh = DesiredScreen[i]->hash;
		c += (*Ph++ == *Dh++);
	}
	*Dh = 12345;	/* sentinel */
	return(c);
}

#define MR	5

/* Runs[0] is a temporary */
/* Runs[1 .. MR-1] contain the MR-1 longest scroll windows */
hidden struct RunList { int start, end, dist, length; } Runs[MR];

hidden procedure Run(i, j, count)
register i, j, count;
{
	register changed;
	register struct RunList *Ri, *Rj;
	char scrolls[MScreenLength];

#ifdef DEBUG
	fprintf(stderr, "i = %2d, j = %2d, count= %2d\n", i, j, count);
#endif
	Runs[0].start = min(i, j);
	Runs[0].end = max(i, j) + count - 1;
	Runs[0].dist = j - i;
	Runs[0].length = count;
	for (i = 1; i < MR; i++) if (Runs[i].length < count) break;
	if (i == MR) return;
	for (j = MR - 2; j >= i; j--)
		Runs[j + 1] = Runs[j];
	Runs[i] = Runs[0];
	for (i = 0; i <= ScreenLength; i++) scrolls[i] = 0;
	for (i = 1; i < MR; i++) {	/* filter occluded scrolls */
		Ri = Runs + i;
		if (Ri->length == 0) break;
		changed = 0;
		while (scrolls[Ri->start]) {
			Ri->start++;
			changed++;
		}
		while (scrolls[Ri->end]) {
			Ri->end--;
			changed++;
		}
		for (j = Ri->start; j <= Ri->end; j++)
			scrolls[j] = 1;
		if (!changed) continue;
		if (Ri->end < Ri->start)
			Ri->length = 0;
		else
			Ri->length = Ri->end - Ri->start + 1 -
				((Ri->dist < 0) ? (-Ri->dist) : Ri->dist);
		for (j = i + 1; j < MR; j++) {
			Rj = Runs + j;
			if (Rj->length > Ri->length) {
				Runs[0] = *Rj;
				*Rj = *Ri;
				*Ri = Runs[0];
			}
			Ri++; Rj++;
		}
	}
}

hidden procedure GetRuns()
{
	register int i, j, count;
	register int *Ph, *Dh;

#ifdef DEBUG
	Ph = PhysHash + 1; Dh = DesiredHash + 1;
	for (i = 1; i <= ScreenLength; i++)
		fprintf(stderr, "Ph[%2d]: %14d, Dh[%2d]: %14d\n", i, *Ph++,
			i, *Dh++);
	fprintf(stderr, "\n");
#endif
	Runs[0].start = Runs[0].end = Runs[0].dist = Runs[0].length = 0;
	for (i = 1; i < MR; i++) Runs[i] = Runs[0];
	for (i = 1; i <= ScreenLength; i++)
		for (j = 1; j <= ScreenLength; j++) {
			count = 0;
			Ph = PhysHash + i;
			Dh = DesiredHash + j;
			while (*Ph++ == *Dh++) count++;
			if (count) Run(i, j, count);
			j += count;
		}
}

hidden procedure DoScroll(i)
{
    struct RunList *Rp = Runs + i;

    if (Rp -> length == 0 || Rp -> dist == 0 ||
	    abs (Rp -> dist) * (tt.t_ILmf > 0.0) > Rp -> length)
	return;
    if (tt.t_window)
	(*tt.t_window) (Rp -> end);
    if (Rp -> dist < 0) {	/* scroll up */
	topos (Rp -> start, 1);
	deletelines (-Rp -> dist);
	if (!tt.t_window) {
	    topos (Rp -> end + Rp -> dist + 1, 1);
	    insertlines (-Rp -> dist);
	}
	for (i = Rp -> start; i < Rp -> start - Rp -> dist; i++)
	    ReleaseLine (PhysScreen[i]);
	for (i = Rp -> start; i <= Rp -> end + Rp -> dist; i++)
	    PhysScreen[i] = PhysScreen[i - Rp -> dist];
	for (i = Rp -> end + Rp -> dist + 1; i <= Rp -> end; i++)
	    PhysScreen[i] = 0;
    }
    else {			/* scroll down */
	if (!tt.t_window) {
	    topos (Rp -> end - Rp -> dist + 1, 1);
	    deletelines (Rp -> dist);
	}
	topos (Rp -> start, 1);
	insertlines (Rp -> dist);
	for (i = Rp -> end; i > Rp -> end - Rp -> dist; i--)
	    ReleaseLine (PhysScreen[i]);
	for (i = Rp -> end; i >= Rp -> start + Rp -> dist; i--)
	    PhysScreen[i] = PhysScreen[i - Rp -> dist];
	for (i = Rp -> start; i < Rp -> start + Rp -> dist; i++)
	    PhysScreen[i] = 0;
    }
}

hidden procedure FastScroll()
{
    register    i;

    if (ScreenLength - QuickHash () <= 2)
	return;			/* few lines changed */
    GetRuns ();
#ifdef DEBUG
    for (i = 0; i < MR; i++)
	fprintf (stderr, "Runs[%d]: %4d%4d%4d%4d\n", i, Runs[i].start,
		Runs[i].end, Runs[i].dist, Runs[i].length);
    fprintf (stderr, "\n");
#endif
    for (i = 1; i < MR && Runs[i].length; i++)
	DoScroll (i);
}
#else
/*	1   2   3   4   ....	Each Mij represents the minumum cost of
      +---+---+---+---+-----	rearranging the first i lines to map onto
    1 |   |   |   |   |		the first j lines (the j direction
      +---+---+---+---+-----	represents the desired contents of a line,
    2 |   |  \| ^ |   |		i the current contents).  The algorithm
      +---+---\-|-+---+-----	used is a dynamic programming one, where
    3 |   | <-+Mij|   |		M[i,j] = min( M[i-1,j],
      +---+---+---+---+-----		      M[i,j-1]+redraw cost for j,2
    4 |   |   |   |   |			      M[i-1,j-1]+the cost of
      +---+---+---+---+-----			converting line i to line j);
    . |   |   |   |   |		Line i can be converted to line j by either
    .				just drawing j, or if they match, by moving
    .				line i to line j (with insert/delete line)
 */

bighidden struct Msquare {
    short   cost;		/* the value of Mij */
    char    fromi,
            fromj;		/* the coordinates of the square that
				   the optimal move comes from */
}                       M[MScreenLength + 1][MScreenLength + 1];

hidden procedure calcM () {
    register struct Msquare *p;
    register    i,
                j,
                movecost,
                cost;
    int     reDrawCost,
            idcost,
            leftcost;
    double  fidcost;

    cost = 0;
    movecost = 0;
    fidcost = tt.t_ILmf * ScreenLength;
    for (i = 0; i <= ScreenLength; i++) {
	p = &M[i][0];
	p[i].cost = 0;
	M[0][i].cost = cost + movecost;
	p[0].cost = movecost;
	M[0][i].fromi = 0; 
	M[0][i].fromj = p[i].fromj = i - 1;
	p[0].fromi = p[i].fromi = i - 1;
	p[0].fromj = 0;
	movecost += fidcost + tt.t_ILov;
	fidcost -= tt.t_ILmf;
	if (DesiredScreen[i + 1])
	    cost += DesiredScreen[i + 1] -> DrawCost;
    }

    fidcost = tt.t_ILmf * (WindowSize + 1) + tt.t_ILov;
    for (i = 1; i <= WindowSize; i++)
    {
	p = &M[i][0];
	fidcost -= tt.t_ILmf;
	idcost = fidcost;
	for (j = 1; j <= WindowSize; j++) {
	    p++; 
	    cost =  DesiredScreen[j] ? DesiredScreen[j] -> DrawCost : 0;
	    reDrawCost = cost;
	    if (PhysScreen[i] && DesiredScreen[j]
		    && PhysScreen[i] -> hash == DesiredScreen[j] -> hash)
		cost = 0;
	    movecost = p[-MScreenLength-1].cost
				+ (j == WindowSize ? 0 : idcost);
	    p -> fromi = i - 1;	/* now using movecost for */
	    p -> fromj = j;	/* the minumum cost. */
	    if ((
			leftcost = p[-1].cost
				+ (i == WindowSize ? 0 : idcost) + reDrawCost
		    ) < movecost) {
		movecost = leftcost;
		p -> fromi = i;
		p -> fromj = j - 1;
	    }
	    cost += p[-MScreenLength-2].cost;
	    if (cost < movecost)
		movecost = cost,
		    p -> fromi = i - 1, p -> fromj = j - 1;
	    p -> cost = movecost;
	}
    }
}

/* calculate and perform the optimal sequence of insertions/deltions
   given the matrix M from routine calcM */

hidden procedure CalcID (i, j, InsertsDesired)
register    i,
            j; {
    register    ni,
                nj;
    register struct Msquare *p = &M[i][j];
    if (i > 0 || j > 0) {
	ni = p -> fromi;
	nj = p -> fromj;
	if (ni == i) {
	    CalcID (ni, nj, i != WindowSize ? InsertsDesired + 1 : 0);
	    InsertsDesired = 0;
	    if (InputPending) {
		if (PhysScreen[j] != DesiredScreen[j])
		    ReleaseLine (PhysScreen[j]);
		PhysScreen[j] = 0;
		ReleaseLine (DesiredScreen[j]);
		DesiredScreen[j] = 0;
		LastRedisplayPaused++;
	    }
	    else {
		UpdateLine (0, DesiredScreen[j], j);
		if (PhysScreen[j] != DesiredScreen[j])
		    ReleaseLine (PhysScreen[j]);
		PhysScreen[j] = DesiredScreen[j];
		DesiredScreen[j] = 0;
	    }
	}
	else
	    if (nj == j) {
		if (j != WindowSize) {
		    register    nni,
		                dlc = 1;
		    for (; ni;) {
			p = &M[ni][nj];
			nni = p -> fromi;
			if (p -> fromj == nj) {
			    dlc++;
			    ni = nni;
			}
			else
			    break;
		    }
		    topos (i - dlc + 1, 1);
		    deletelines (dlc);
		}
		CalcID (ni, nj, 0);
	    }
	    else {
		register struct line   *old = PhysScreen[i];
		register    DoneEarly = 0;
		if (old == DesiredScreen[i]) DesiredScreen[i] = 0;
		PhysScreen[i] = 0;

	    /* The following hack and all following lines involving the
	       variable "DoneEarly" cause the bottom line of the screen to
	       be redisplayed before any others if it has changed and it
	       would be redrawn in-place.  This is purely for Emacs,
	       people using this package for other things might want to
	       lobotomize this section. */
		if (i == ScreenLength && j == ScreenLength
			&& DesiredScreen[j]) {
		    DoneEarly++;
		    UpdateLine (old, DesiredScreen[j], j);
		}
		CalcID (ni, nj, 0);
		if (InputPending && !DoneEarly) {
		    if (PhysScreen[j] != old)
			ReleaseLine (PhysScreen[j]);
		    if (DesiredScreen[j] != old
			    && DesiredScreen[j] != PhysScreen[j])
			ReleaseLine (DesiredScreen[j]);
		    PhysScreen[j] = old;
		    DesiredScreen[j] = 0;
		    LastRedisplayPaused++;
		}
		else {
		    if (!DoneEarly && (DesiredScreen[j] || i != j))
			UpdateLine (old, DesiredScreen[j], j);
		    if (PhysScreen[j] != DesiredScreen[j])
			ReleaseLine (PhysScreen[j]);
		    if (old != DesiredScreen[j] && old != PhysScreen[j])
			ReleaseLine (old);
		    PhysScreen[j] = DesiredScreen[j];
		    DesiredScreen[j] = 0;
		}
	    }
    }
    if (InsertsDesired) {
	topos (j + 1, 1);
	insertlines (InsertsDesired);
    }
}
#endif


/* modify current screen line 'old' to match desired line 'new',
   the old line is at position ln.  Each line
   is scanned and partitioned into 4 regions:

	     <osp><----m1-----><-od--><----m2----->
    old:    "     Twas brillig and the slithy toves"
    new:    "        Twas brillig where a slithy toves"
             <-nsp--><----m1-----><-nd--><----m2----->

	nsp, osp	- number of leading spaces on each line
	m1		- length of a leading matching sequence
	m2		- length of a trailing matching sequence
	nd, od		- length of the differing sequences
 */
hidden procedure UpdateLine (old, new, ln)
register struct line	*old,
			*new; {
    register char	*op,
			*np,
			*ol,
			*nl;
    int	osp,
	nsp,
	m1,
	m2,
	od,
	nd,
	OldHL,
	NewHL,
	t;

    if (old == new)
	return;
    if (old) {
	op = old -> body;
	ol = &old -> body[old -> length];
	OldHL = old -> highlighted;
    }
    else
	op = "", ol = op, OldHL = 0;
    if (new) {
	np = new -> body;
	nl = &new -> body[new -> length];
	NewHL = new -> highlighted;
    }
    else
	np = "", nl = np, NewHL = 0;
    osp = nsp = m1 = m2 = od = nd = 0;

    if (ol-op == nl-np && OldHL == NewHL && !strcmpn(op, np, ol-op))
	goto cleanup;

    (*tt.t_HLmode) (NewHL);

/* calculate the magic parameters */
    if (NewHL == OldHL) {
	while (*--ol == ' ' && ol >= op);
	while (*--nl == ' ' && nl >= np);
	while (*op == ' ' && op <= ol)
	    op++, osp++;
	while (*np == ' ' && np <= nl)
	    np++, nsp++;
	while (*op == *np && op <= ol && np <= nl)
	    op++, np++, m1++;
	while (*ol == *nl && op <= ol && np <= nl)
	    ol--, nl--, m2++;
    }
    else {
	topos (ln, 1);
	wipeline (1);

	ol--;
	nl--;
	osp = 0;
	while (*np == ' ' && np < nl)
	    np++, nsp++;
    }
    od = ol - op + 1;
    nd = nl - np + 1;


/* forget matches which would be expensive to capitalize on */
    if (m1 || m2) {
	register int    c0,
	                c1,
	                c2,
	                c3,
			c4;
	c0 = (tt.t_ISmf < 1.0 ? (tt.t_ISov + nsp*tt.t_ISmf) : nsp) + m1 + m2;
	if (c1 = nsp - osp)
	    c1 = c1<0 ? tt.t_DCov - c1*tt.t_DCmf
		      : tt.t_ISov + c1*tt.t_ISmf;
	if (c3 = nd - od)
	    c3 = c3<0 ? tt.t_DCov - c3*tt.t_DCmf
		      : tt.t_ICov + c3*tt.t_ICmf;
	if (c2 = (nsp + nd) - (osp + od))
	    c2 = c2<0 ? tt.t_DCov - c2*tt.t_DCmf
		      : tt.t_ICov + c2*tt.t_ICmf;
	c4 = tt.t_KLov + m1 + m2;
	c3 += c1;
	c1 += m2;
	c2 += m1;
	if (RDdebug)
	    fprintf(stderr, "%2d c0=%2d  c1=%2d  c2=%2d  c3=%2d  c4=%2d\n", ln, c0, c1, c2, c3, c4);
	if (c4 < c0 && c4 < c1 && c4 < c2 && c4 < c3) {
	    topos (ln, 1);
	    wipeline (1);
	    topos (ln, nsp+1);
	    dumpstring(np-m1, nl+m2);
	    goto cleanup;
	}
	if (m2 && (c0 < c2 && c0 < c3 || c1 < c2 && c1 < c3)) {
	    nd += m2;
	    od += m2;
	    ol += m2;
	    nl += m2;
	    m2 = 0;
	}
	if (m1 && (c0 < c1 && c0 < c3 || c2 < c1 && c2 < c3)) {
	    nd += m1;
	    od += m1;
	    np -= m1;
	    op -= m1;
	    m1 = 0;
	}
    }
    if (RDdebug && (m1 || m2 || nd || od)) {
	fprintf (stderr, "%2d nsp=%2d  osp=%2d  m1=%2d  nd=%2d  od=%2d  m2=%2d\n",
		ln, nsp, osp, m1, nd, od, m2);
    }
    if (m1 == 0)
	if (m2 == 0) {
	    if (od == 0 && nd == 0)
		goto cleanup;
	    if (od == 0 && !tt.t_needspaces)
		osp = nsp;
	    topos (ln, (t = min (nsp, osp)) + 1);
	    INSmode (0);
	    if (nsp > osp)
		blanks (nsp - osp);
	    dumpstring (np, nl);
	    if (nsp + nd < osp + od)
		wipeline (0);
	}
	else {			/* m1==0 && m2!=0 && (nd!=0 || od!=0) */
	    t = (nsp + nd) - (osp + od);
	    topos (ln, min (nsp, osp) + 1);
	    if (nsp > osp)
		np -= nsp - osp;
	    if (t >= 0) {
		if (nl - t >= np)
		    INSmode (0), dumpstring (np, nl - t);
		if (t > 0)
		    INSmode (1), dumpstring (nl - t + 1, nl);
	    }
	    else
		INSmode (0), dumpstring (np, nl), deletechars (-t);
	}
    else {			/* m1!=0 */
	register    lsp = osp;
	if (nsp < osp) {
	    topos (ln, 1);
	    deletechars (osp - nsp);
	    lsp = nsp;
	}
	if (m2 == 0) {
	    if (nd == 0 && od == 0) {
		if (nsp > osp) {
		    topos (ln, 1);
		    INSmode (1);
		    blanks (nsp - osp);
		}
		goto cleanup;
	    }
	    if (od == 0 && !tt.t_needspaces)
		while (*np==' ') np++, m1++;
	    topos (ln, lsp + m1 + 1);
	    INSmode (0);
	    dumpstring (np, nl);
	    if (nd < od)
		wipeline (0);
	    if (nsp > osp) {
		topos (ln, 1);
		INSmode (1);
		blanks (nsp - osp);
	    }
	}
	else {			/* m1!=0 && m2!=0 && (nd!=0 || od!=0) */
	    topos (ln, lsp + m1 + 1);
	    t = nd - od;
	    if (nd > 0 && od > 0)
		INSmode (0), dumpstring (np, np + min (nd, od) - 1);
	    if (nd < od)
		deletechars (od - nd);
	    else
		if (nd > od)
		    INSmode (1), dumpstring (np + od, nl);
	    if (nsp > osp) {
		topos (ln, 1);
		INSmode (1);
		blanks (nsp - osp);
	    }
	}
    }
cleanup:
#ifdef IPEND
    if(--CheckForInput<0 && !InputPending &&
				((stdout->_ptr - stdout->_base) > 20)){
	fflush (stdout);
	IPEND(InputPending);
	CheckForInput = baud_rate / 2400;
    }
#endif
}

visible procedure UpdateScreen (SlowUpdate) {
    register    c,
    		n;

    CheckForInput = 999;
    if (ScreenGarbaged) {
	reset ();
	ScreenGarbaged = 0;
	for (n = 0; n <= ScreenLength; n++) {
	    ReleaseLine (PhysScreen[n]);
	    PhysScreen[n] = 0;
	}
    }
    if (CurrentLine >= 0
	    && DesiredScreen[CurrentLine] -> length <= ScreenWidth - left)
	DesiredScreen[CurrentLine] -> length =
	    left > 0 ? ScreenWidth - left : ScreenWidth;
    CurrentLine = -1;
    if (tt.t_ILov == MissingFeature)
	SlowUpdate = 0;
    if (SlowUpdate) {
	for (n = 1; n <= ScreenLength; n++) {
	    if (DesiredScreen[n] == 0)
		DesiredScreen[n] = PhysScreen[n];
	    else
		hashline (DesiredScreen[n]);
	    hashline (PhysScreen[n]);
	}
	CheckForInput = baud_rate / 2400;
#ifdef SLOWCPU
	FastScroll();
	SlowUpdate = 0;
#else
	c = 0;
	for (n = ScreenLength; n >= 1 && c <= 2; n--)
	    if (PhysScreen[n] != DesiredScreen[n]
		    && PhysScreen[n]
		    && DesiredScreen[n] -> hash != PhysScreen[n] -> hash)
		c++;
	if (c <= 2)
	    SlowUpdate = 0;
	else {
	    if (tt.t_window) {
		for (n = ScreenLength;
			n >= 1
			&& (PhysScreen[n] == DesiredScreen[n]
			    || PhysScreen[n]
			    && DesiredScreen[n] -> hash == PhysScreen[n] -> hash);
			n--);
		WindowSize = n;
		(*tt.t_window) (n);
	    }
	    else
		WindowSize = ScreenLength;
	    calcM ();
	    CalcID (ScreenLength, ScreenLength, 0);
	}
#endif
    }
    if (!SlowUpdate) {		/* fast update */
	for (n = 1; n <= ScreenLength; n++)
	    if (DesiredScreen[n]) {
		UpdateLine (PhysScreen[n], DesiredScreen[n], n);
		if (PhysScreen[n] != DesiredScreen[n])
		    ReleaseLine (PhysScreen[n]);
		PhysScreen[n] = DesiredScreen[n];
		DesiredScreen[n] = 0;
	    }
    }
    (*tt.t_HLmode) (0);
    if (!InputPending)
	topos (cursY, cursX);
}

static VisibleBell;		/* If true and the terminal will support it
				   then the screen will flash instead of
				   feeping when an error occurs */

/* DJH common routine for a feep */
Ding () {			/* BOGUS!  this should really be terminal
				   type specific! */
    if (VisibleBell && tt.t_flash) (*tt.t_flash) ();
    else vputchar (07);
}

/* DLK routine to make the cursor sit for n/10 secs */
hidden procedure SitFor () {
    register    num_chars, CharsPerInputCheck;

    if(InputPending || stdin->_cnt!= 0) return 0;
    DoDsp (1);			/* Make the screen correct */
    INSmode (0);
    CharsPerInputCheck = baud_rate / 100;
    num_chars = getnum (": sit-for ") * CharsPerInputCheck;
    while (num_chars-- && !InputPending){
#ifdef IPEND
	if ( ((num_chars+1) % CharsPerInputCheck) == 0){
		fflush (stdout);
		IPEND(InputPending);
	}
#endif
	vputchar(0);		/* BOGUS! this should really be terminal type
				   specific; cannot call dumpstring since
				   that updates the current cursor position */
    }
    return 0;
}

/* initialize the teminal package */
term_init (type)
char   *type; {
    static short    baud_convert[] =
    {
	0, 50, 75, 110, 135, 150, 200, 300, 600, 1200,
	1800, 2400, 4800, 9600
    };
    struct sgttyb   sg;
    extern short    ospeed;
    static  BeenHere;		/* true iff we've been here before (some
				   things must only be done once!) */

    RDdebug = 0;		/* line redraw debug switch */
    IDdebug = 0;		/* line insertion/deletion debug */
    cursX = 1;			/* X and Y coordinates of the cursor */
    cursY = 1;			/* between updates. */
    CurrentLine = -1;		/* current line for writing to the
				   virtual screen. */
    left = -1;			/* number of columns left on the current
				   line of the virtual screen. */
    if (!BeenHere) {
	char   *tname = (char *) getenv ("TERM");
	struct termtype {
	    char   *name;
	    int     cmplen;
	    int     (*startup) ();
	};
    /* A terminal driver is selected by looking up the value of the
       environment variable TERM in the following table.  The string is
       matched against the name, considering at most "cmplen" characters
       to be significant.  "startup" points to the function that sets up
       the terminal driver.  The driver is called with the terminal type
       as a parameter and is free to use that to specialize itself. */
	struct termtype *p;
	extern  TrmVT100 ();
        extern  TrmVi200 ();
	extern  TrmWy75 ();
	static struct termtype  termtable[] = {
	    "vt100", 5, TrmVT100,
	    "vi200", 5, TrmVi200,
	    "wy75", 4, TrmWy75,
	    0, 0, 0
	};
	BeenHere++;
	if (tname == 0)
	    tname = "concept";
	gtty (fileno (stdin), &sg);
	ospeed = sg.sg_ospeed;
	baud_rate = sg.sg_ospeed == 0 ? 1200
	    : sg.sg_ospeed < sizeof baud_convert / sizeof baud_convert[0]
	    ? baud_convert[sg.sg_ospeed] : 9600;
	for (p = termtable; p -> name; p++)
	    if (strcmpn (p -> name, tname, p -> cmplen) == 0) {
		(*p -> startup) (tname);
		break;
	    }
	if (p -> name == 0)
	    TrmTERM (tname);
	defproc (SitFor, "sit-for");
	DefIntVar ("visible-bell", &VisibleBell);
    }
    (*tt.t_init) (baud_rate);
/*    (*tt.t_reset) ();  */
}

#ifndef SLOWCPU
/* Debugging routines -- called from sdb only */

/* print out the insert/delete cost matrix */
PrintM () {
    register    i,
                j;
    register struct Msquare *p;
    for (i = 0; i <= ScreenLength; i++) {
	for (j = 0; j <= ScreenLength; j++) {
	    p = &M[i][j];
	    fprintf (stderr, "%4d%c", p -> cost,
		    p -> fromi < i && p -> fromj < j ? '\\' :
		    p -> fromi < i ? '^' :
		    p -> fromj < j ? '<' : ' ');
	}
	fprintf (stderr, "\n");
    }
    fprintf (stderr, "\014");
}
#endif

dsp.c           508005722   1094  1000  100644  2658      `

/* Display routines */

/*		Copyright (c) 1981,1980 James Gosling		*/

#include "config.h"
#include "keyboard.h"
#include "buffer.h"
#include "window.h"
#include "display.h"
#ifdef subprograms
#include "subprogram.h"
#endif
#include <stdio.h>
#ifndef apm      /* RDW dec-85 */
#include <sys/ioctl.h>
#include <sgtty.h>

struct sgttyb old;		/* The initial tty mode bits */

/* to save to old flow control characters while flow is managed by 
   the socket world.    purtilo   */

#ifdef uiuc
struct	tchars   oldtt;
struct	tchars *oldttp;
char	oldxoff, oldxon;
#endif

#else apm
static int olde;
#endif

extern QuitDoRstDsp;	/* added by mkc:need to restore the display somehow */

/* Redirectable terminal output routines (FDC) */

static
FILE *termscript;

static
OpenTermscript()
{
	register char *fn = getstr(": termscript file ");

	if (fn && (termscript = fopen(fn, "w")) == NULL)
		error("Can't open %s", fn);
	return 0;
}

vputchar(c)
register char c;
{
#ifdef subprograms
	extern PFI ScreenPut;

	asm("	clrl	.d0");
	asm("	movb	.d7,.d0");
	(*ScreenPut)();
#else
	putchar(c);
#endif
	if (termscript) putc(c, termscript);
}

vputs(s)
register char *s;
{
	while (*s) vputchar(*s++);
}

vprintf(fmt, arg)
char *fmt;
{
	char buf[BUFSIZ];
	struct _iobuf strbuf;

	strbuf._flag = _IOSTRG;
	strbuf._ptr = buf;
	strbuf._cnt = BUFSIZ - 1;
	_doprnt(fmt, &arg, &strbuf);
	putc('\0', &strbuf);
	vputs(buf);
}


InitDsp () {
    extern char _sobuf[];
#ifndef apm      /* RDW dec-85 */
    struct sgttyb   sg;

#ifdef uiuc
    int newmode;
    oldttp = &oldtt;
#endif

    gtty (0, &old);
    sg = old;
    sg.sg_flags = (sg.sg_flags & ~(ECHO | CRMOD | XTABS)) | RAW;
    stty (0, &sg);

#ifdef uiuc
    ioctl( 0, TIOCGETC, oldttp );
    oldxon = oldttp->t_startc;
    oldttp->t_startc = 0377;
    oldxoff = oldttp->t_stopc;
    oldttp->t_stopc = 0377;
    ioctl( 0, TIOCSETC, oldttp );
    vprintf("%c",NULL);    /* remove this and get surprise ... purtilo */
#endif
#else
   (void) sterm(15);
   olde = emask;
   emask = 0XFFFFFFFF;
#endif

    ScreenGarbaged = 1;
    setbuf (stdout, _sobuf);

    QuitDoRstDsp++;	/* ??? added by mkc */
    term_init ();
    defproc(OpenTermscript, "open-termscript");
    }

RstDsp () {

#ifndef apm
#ifdef uiuc
    oldttp->t_startc = oldxon;
    oldttp->t_stopc = oldxoff;
    ioctl( 0, TIOCSETC, oldttp );
#endif
#else
   sterm(0);
   emask = olde;
   ConnectOutput(NULLFUNC);
#endif

    if (tt.t_window) (*tt.t_window) (0);
    (*tt.t_topos) (1, 1);
    (*tt.t_dellines) (1);
    (*tt.t_topos) (ScreenLength, 1);
    (*tt.t_wipeline) (0);
    (*tt.t_cleanup) ();
    fflush (stdout);
#ifndef apm
    stty (0, &old);
#endif
}
emacs.c         508664651   1094  1000  100644  19168     `
/* Yes folks!  This is it!  A for-real Unix Emacs!  With
   all (well...) those features we've come to know and love.

		This atrocity brought to you by:
			James Gosling
			October, 1980
			@ CMU
*/

/*		Copyright (c) 1981,1980 James Gosling		*/

#ifndef lint
static char sccsid[]="@(#)emacs   University of Maryland  26-Oct-1982";
#endif

#include "buffer.h"
#include "window.h"
#include "keyboard.h"
#include "macros.h"
#include "config.h"
#include "mlisp.h"
#include <signal.h>
#include <sgtty.h>
#include <errno.h>
#include <pwd.h>

#ifdef OneEmacsWarning
#undef FIOCXMOD
#endif

char	*MyTtyName,		/* Name of the tty we're talking to */
	*getenv ();

static  SilentlyKillProcesses;	/* if true, don't ask that annoying
				   question about processes still on the
				   prowl: just kill them! */

static	SilentlyExitEmacs;	/* if true, don't ask that annoying
				   question about modified buffers
				   existing: just exit without
				   saving them! */

int	sflag,			/* share-emacs flag */
	QuitDoRstDsp,		/* if set, quit() will RstDsp() */
	QuitDoQuitMpx;		/* if set, quit() will QuitMpx() */
extern  errno;			/* error number returned from Unix
				   system calls */

#ifdef OneEmacsPerTty
static char LockFile[50];	/* The lock file used to determine
				   whether or not multiple emaces are
				   running on this tty */
#ifdef OneEmacsWarning
static AlreadyLocked;		/* True iff lock file was already present */
#endif

UnlockTty () {			/* Allow other Emaces to be created on
				   this tty */
#ifdef OneEmacsWarning
    if (!AlreadyLocked)
#endif
#ifdef apm
	asm ("	lea	[lock,.a4],.a0");
	asm ("	movw	#0,.a0@(2)");
#else
	unlink (LockFile);
#endif
}

static  LockTty () {		/* Try to set the per-tty lock.  If we
				   fail, exit back to Unix with a
				   message. */
#ifdef apm
    register short lockval;

    asm ("	clrl	.d7");
    asm ("lock:	movw	#0,.d7");
    if (lockval) {
	char    buf[100];
	AlreadyLocked++;
	printf ("It appears that there are multiple invocations of Emacs running on this APM.\n");
	printf ("You probably don't want to do this since it ties up system resources.\n");
	printf ("Do you want me to go ahead and run anyway? ");
	if ('y' != *(char *) gets (buf))
	    exit (1);
    }
    lockval++;		/* to force 'if' label */
    asm ("	lea	[lock,.a4],.a0");
    asm ("	movw	#1,.a0@(2)");
#else
    register    fd;
    register char  *tt = MyTtyName;
    register char  *p;
#ifdef FIOCXMOD
    int     ExclusiveMode;
#endif
    for (p = tt; *p;)
	if (*p++ == DIRDELIMC)
	    tt = p;
    sprintfl (LockFile, sizeof LockFile, "/tmp/Emacs-%s", tt);
#ifdef FIOCXMOD			/* use the exclusive access feature if
				   this Unix has it */
    fd = creat (LockFile, 0666);
    ExclusiveMode = FXMWRITE;
    if (fd < 0 && errno != EBUSY) {
	unlink (LockFile);
	fd = creat (LockFile, 0666);
    }
    if (fd < 0 || ioctl (fd, FIOCXMOD, &ExclusiveMode) < 0) {
	printf ("\
There is already an Emacs running on this terminal.  Since the Unix Kernel\n\
has some rather nasty bugs, if another Emacs starts up all hell will break\n\
loose.  Hence, you'd better get rid of that other Emacs before starting up\n\
a new one.\n");
	exit (1);
    }
    chmod (LockFile, 0666);
#else
    fd = creat (LockFile, 000);
    if (fd < 0) {
	char    buf[100];
#ifdef OneEmacsWarning
	AlreadyLocked++;
	printf ("\
It appears that there are multiple invocations of Emacs running on this\n\
terminal.  You probably don't want to do this since it ties up system\n\
resources.  Do you want me to go ahead and run anyway? ");
#else
	printf ("\
It appears that there are multiple invocations of Emacs running on this\n\
terminal.  You probably don't want to do this since there is a bug in the\n\
Unix kernel that prevents this from working properly.  Do you want me to\n\
ignore this and run anyway? ");
#endif
	if ('y' != *(char *) gets (buf))
	    exit (1);
	unlink (LockFile);
	fd = creat (LockFile, 000);
	if (fd < 0) {
	    printf ("\
Something serious is preventing me from interlocking your tty.  Contact\n\
the person who maintains Emacs at your site.\n");
	    exit (1);
	}
    }
    close (fd);
#endif
#endif
}
#endif

#ifdef SIGXCPU
static
        TimeLimit () {		/* Signal handler for CPU time limit */
    CheckpointEverything ();
    quit (1,
"Emacs has encountered a CPU time limit.  All of the files\n\
that you were editing and have changed have been checkpointed.\n");
}
#endif

static
        AbnormalTerminate () {	/* Signal handler for abnormal
				   terminations */
    CheckpointEverything ();
    quit (1,
"Emacs has encountered an abnormal termination signal.  All of the files\n\
that you were editing and have changed have been checkpointed.\n");
}

/* Code for dealing with MLisp access to the Unix command line */
static  Gargc;			/* global versions of argv and argc, for
				   use by MLisp functions */
static char **Gargv;
static  TouchedCommandArgs;	/* true iff the user has touched the
				   Unix command line arguments, this
				   stops Emacs from doing the VisitFiles
				   */

static InvisArgc () {		/* return the value of argc */
    MLvalue -> exp_type = IsInteger;
    MLvalue -> exp_int = Gargc;
    return 0;
}

static  Argc () {		/* return the value of argc */
    MLvalue -> exp_type = IsInteger;
    MLvalue -> exp_int = Gargc;
    TouchedCommandArgs++;
    return 0;
}

static InvisArgv () {
    return DoArgv (1);
}

static Argv () {
    return DoArgv (0);
}

static  DoArgv (invis) {	/* return the value of argv[i] */
    register int    n;
    register char  *s = invis ? "invisible-" : "";

    n = getnum (": %sargv index: ", s);
    if (!err)
	if (n >= Gargc)
	    error ("%sargv can't return the %d'th argument, there are only %d",
		    s, n, Gargc);
	else {
	    MLvalue -> exp_type = IsString;
	    MLvalue -> exp_v.v_string = Gargv[n];
	    MLvalue -> exp_int = strlen (MLvalue -> exp_v.v_string);
	}
    if (!invis)
	TouchedCommandArgs++;
    return 0;
}

/* Define an autoloaded function, bound to the indicated key */
static
        DefAutoload (routine, file, map, key)
char   *routine;
char   *file;
struct keymap  *map; {
    DefMac (routine, file, -1);
    if (key >= 0)
	map -> k_binding[key] = MacBodies[FindMac (routine)];
}

main (argc, argv)
char  **argv; {
    char    combuf[100];
    FILE * args = 0;
    char   *lflag = "";		/* value from the -l switch -- file to
				   load after .emacs_pro */
    char   *eflag = "";		/* value from the -e switch -- function
				   to execute after doing the -l load */
    int     qflag = 0,		/* set if emacs is called with the -q
				   (quick) option */
	    dontremember = 0,	/* set if emacs is called with -d (do not
				    create .emacs_uid files) */
	    modbufcount;	/* count of modified buffers */

    register    i, rv = 0;
    struct passwd *pwdptr,
		  *getpwnam ();
    char uflag[100];		/* expanded value of the -u switch */
    char *xflag = "";		/* value from the -x switch */

#ifdef apm
    extern char HeapLevel;
    asm("	movl	.a5@(724),.a0");	/* local heap descriptor */
    asm("	movl	[C_HeapLevel,.a4],.a1");
    asm("	movb	.a0@(4),.a1@");
    asm("	.data");
    asm("C_HeapLevel:	.vect	\"C_HeapLevel\",.extdata,1");
    asm("	.text");
#endif
    uflag[0] = 0;
    setgid (getegid ());	/* Hack fix for setgid shell scripts, because
				   the access system call checks real gid */
    setuid (geteuid ());	/* As above */
#ifdef apm
    MyTtyName = "Fred00";
    sprintf(MyTtyName + 4, "%2X", *((char *) 0x3fa8));	/* LDTE */
#else
    MyTtyName = (char *) ttyname (0);
#endif
    if (MyTtyName == 0)
	MyTtyName = "";		/* In case we're piped to, or some other such
				   silliness */
#ifdef OneEmacsPerTty
    LockTty ();
#endif
#ifdef DumpableEmacs
    TouchedCommandArgs = 0;	/* on restart */
    QuitDoRstDsp = 0;		/* " */
    QuitDoQuitMpx = 0;		/* " */
#endif
    Gargc = argc;
    Gargv = argv;
    signal (SIGHUP, AbnormalTerminate);
    signal (SIGINT, AbnormalTerminate);
    signal (SIGTERM, AbnormalTerminate);
#ifdef DumpableEmacs
    if (!Once)
#endif
    {
	NewNames = MacBodies;
	VarNames = (char **) malloc ((VarTSize = 200) * sizeof *VarNames);
	VarDesc = (struct VariableName **) malloc (VarTSize * sizeof *VarDesc);
	NextInitVarName = VarNames;
	NextInitVarDesc = VarDesc;
    }
    sflag = 1;

/* Command line switch processing.  Emacs understands the following command
 * line switches:
 *	-t<ttyname>	causes Emacs to do its IO to the named tty
 *	-e<funcname>	causes Emacs to execute the named function when it
 *			starts up.
 *	-l<filename>	causes Emacs to load the named file with it starts up
 *			(this is done before the processing for -e)
 *	-s		disables the share-emacs facility
 *	-u<username>	causes Emacs to read the .emacs_pro file from the
 *			specified user's home directory
 *	-x<funcname>	causes Emacs to execute the named function after
 *			visiting any files
 *	-q		quick Emacs; do not load .emacs_pro
 *	-d		do not create .emacs_uid files
 */

    for (i = 1; i < argc; i++)
	if (argv[i][0] == '-')
	    switch (argv[i][1]) {
		case 't': 
		    {
			char    tty[100];
			sprintfl (tty, sizeof tty, "/dev/%s", argv[i] + 2);
			close (0);
			close (1);
			open (tty, 2);
			dup (0);
			fprintf (stderr, "Using %s\n", tty);
		    }
		    break;
		case 'l': 
		    lflag = argv[i] + 2;
		    break;
		case 'e': 
		    eflag = argv[i] + 2;
		    break;
		case 's': 
		    sflag = 0;
		    break;
		case 'q':
		    qflag++;
		    break;
		case 'd':
		    dontremember++;
		    break;
		case 'u':
#ifdef apm
/* no -u at present */
		    uflag[0] = 0;
		    quit(1, "-u no supported");
#else
		    strcpy (uflag, argv[i][2] ? &argv[i][2] : getenv ("USER"));
		    if ((pwdptr = getpwnam (uflag)) == (struct passwd *) 0)
			quit (1, "Unknown user: %s\n", uflag);
		    else
			strcpy (uflag, pwdptr -> pw_dir);
		    break;
#endif
		case 'x':
		    xflag = argv[i] + 2;
		    break;
		default: 
		    quit (1, "Unknown switch: %s\n", argv[i]);
	    }

#ifdef DumpableEmacs
    if (!Once)
#endif
    {
#ifdef DumpableEmacs
	extern DumpEmacs ();
	defproc (DumpEmacs, "dump-emacs");
#endif
	defproc (Argc, "argc");
	defproc (Argv, "argv");
	defproc (InvisArgc, "invisible-argc");
	defproc (InvisArgv, "invisible-argv");
	DefIntVar ("silently-kill-processes", &SilentlyKillProcesses);
	DefIntVar ("silently-exit-emacs", &SilentlyExitEmacs);
	DefIntVar ("no-.emacs_uid-files", &dontremember);
    }
#ifndef apm
    InitMpx ();			/* Initialize the multiplex i/o stuff */
#endif
#ifdef subprograms
    InitProg();			/* " commands that deal with subprograms */
#endif
    QuitDoQuitMpx++;
    Initbf ();			/* " the buffer system */
    InitDsp ();			/* " the display */
    InitWin ();			/* " the window system */
    InitSimp ();		/* " the simple commands */
    InitSpell ();		/* " the probabalistic spelling checker */
    InitWnMan ();		/* " the window management commands */
    InitFIO ();			/* " the file IO system */
    InitMiniBuf ();		/* " the minibuffer system (DJH) */
    InitSrch ();		/* " the search commands */
    InitMeta ();		/* " the simple meta commands */
#ifdef subprocesses
    InitProc ();		/* " commands that deal with subprocesses */
#endif
    InitOpt ();			/* " commands that deal with options */
    InitKey ();			/* " commands that deal with options */
    InitAbbrev ();		/* " the abbrev system */
    InitSyntax ();		/* " the syntax table system */
    InitDb ();			/* " the data base manager */
    InitCase ();		/* " the case manipulation commands */
    InitUndo ();		/* " the undo facility */
    InitArith ();		/* " the arithmetic operators (for lisp) 
				 */
    InitFunc ();		/* " lisp environment enquiry functions 
				*/
    InitLisp ();		/* " the MLisp system */
    InitAbs ();			/* " the current directory name */
#ifdef newmalloc
    InitMalloc ();		/* " the memory allocator */
#endif newmalloc
    InitMacros ();		/* " the macro system and name bindings
				   WARNING:	this initialization
				   procedure must be called after all
				   the others */

#ifdef SIGXCPU
    signal (SIGXCPU, TimeLimit);
#endif

/* Autoload definitions.  Sadly, these must follow the call to InitMacros
   and cannot be done in the relevant InitXX routine */
#ifdef DumpableEmacs
    if (!Once)
#endif
    {
	DefAutoload ("shell", "process.ml", 0, -1);
	DefAutoload ("justify-paragraph", "justify.ml", 0, -1);
	DefAutoload ("info", "info.ml", 0, -1);
	DefAutoload ("learn", "learn.ml", 0, -1);
	DefAutoload ("manual-entry", "man.ml", 0, -1);
#ifdef apm
	DefAutoload ("text-mode", "text.ml", 0, -1);
	DefAutoload ("c-mode", "cmode.ml", 0, -1);
	DefAutoload ("normal-mode", "normal.ml", 0, -1);
	DefAutoload ("backward-paragraph", "paras.ml", &ESCmap, '[');
	DefAutoload ("forward-paragraph", "paras.ml", &ESCmap, ']');
#else
	DefAutoload ("text-mode", "text-mode.ml", 0, -1);
	DefAutoload ("c-mode", "c-mode.ml", 0, -1);
	DefAutoload ("normal-mode", "normal-mode.ml", 0, -1);
	DefAutoload ("backward-paragraph", "paragraphs.ml", &ESCmap, '[');
	DefAutoload ("forward-paragraph", "paragraphs.ml", &ESCmap, ']');
#endif
	DefAutoload ("electric-lisp-mode", "mlisp.ml", 0, -1);
	DefAutoload ("describe-command", "info.ml", 0, -1);
	DefAutoload ("describe-variable", "info.ml", 0, -1);
	DefAutoload ("expand-mlisp-word", "expandX.ml", 0, -1);
	DefAutoload ("expand-mlisp-variable", "expandX.ml", 0, -1);
	DefAutoload ("describe-word-in-buffer", "DesWord.ml", &CtlXmap, Ctl ('d'));
	DefAutoload ("backward-sentence", "sentences.ml", &ESCmap, 'a');
	DefAutoload ("forward-sentence", "sentences.ml", &ESCmap, 'e');
	DefAutoload ("rmail", "rmail.ml", &CtlXmap, 'r');
	DefAutoload ("smail", "rmail.ml", &CtlXmap, 'm');
	DefAutoload ("cd", "pwd.ml", 0, -1);
	DefAutoload ("pwd", "pwd.ml", 0, -1);
	DefMac ("default-global-keymap", &GlobalMap, -2);
	DefMac ("ESC-prefix", &ESCmap, -2);
	DefMac ("Minibuf-local-map", &MinibufLocalMap, -2);
	MinibufLocalMap.k_binding['\n'] = GlobalMap.k_binding[3];
	MinibufLocalMap.k_binding['\r'] = GlobalMap.k_binding[3];
	GlobalMap.k_binding[033] = MacBodies[FindMac ("ESC-prefix")];
	MinibufLocalMap.k_binding['\033'] = GlobalMap.k_binding[3];
	MinibufLocalMap.k_binding['\034'] = GlobalMap.k_binding['\033'];
	DefMac ("Minibuf-local-NS-map", &MinibufLocalNSMap, -2);
	MinibufLocalNSMap = MinibufLocalMap;
	MinibufLocalNSMap.k_binding[' '] = GlobalMap.k_binding[3];
	MinibufLocalNSMap.k_binding['\t'] = GlobalMap.k_binding[3];
	MinibufLocalNSMap.k_binding['?'] =
			    MacBodies [FindMac ("self-insert-and-exit")];
	DefMac ("^X-prefix", &CtlXmap, -2);
	GlobalMap.k_binding[030] = MacBodies[FindMac ("^X-prefix")];
	CurrentGlobalMap = &GlobalMap;
	InitArrows();		/* see arrows.c MKC */
	NVars = NextInitVarName - VarNames;
	*NextInitVarName = 0;	/* in case your malloc gives you dirty core */
	*NextInitVarDesc = 0;	/* " */
    }
#ifdef DumpableEmacs
    Once = 1;			/* past one-time init code */
#endif
    if (!qflag) {
	char    buf[MaxPathNameLen];
	register char  *home;

	if (home = *uflag ? uflag : getenv("HOME"))
#ifdef apm
	    sprintfl (buf, sizeof buf, "%s:.emacs_pro", home);
#else
	    sprintfl (buf, sizeof buf, "%s/.emacs_pro", home);
#endif
	else
	    *buf = '\0';
	if (ExecuteMLispFile (buf, 1))
	    ExecuteMLispFile (DefaultProfile, 1);
    }
    InputFD = stdin;

    if (lflag[0])
	ExecuteMLispFile (lflag, 1);
    rv = 0;
    if (eflag[0] && (i = FindMac (eflag)) >= 0)
	rv = ExecuteBound (MacBodies[i]);

    if (rv == 0) {
	if (!TouchedCommandArgs) {
	    int     DoneAnyVisiting = 0;
/* (ACT) Visit in reverse order so that first named comes out on top */
	    for (i = argc - 1; i ; i--)
		if (argv[i][0] != '-') {
		    VisitFile (argv[i], 1, 1);
		    DoneAnyVisiting++;
		}
	    if (!DoneAnyVisiting && !dontremember &&
		    (args = fopen (sprintf (combuf, ".emacs_%d", getuid ()), "r")) != 0)
		while (fgets (combuf, 100, args)) {
		    register char  *p = combuf;
		    register    i;
		    while (*p >= ' ')
			p++;
		    i = *p;
		    *p++ = '\0';
		    VisitFile (combuf, 1, 1);
		    if (i == 1) {
			i = 0;
			while ('0' <= *p && *p <= '9')
			    i = i * 10 + *p++ - '0';
			if (i >= FirstCharacter && i <= NumCharacters)
			    SetDot (i);
		    }
		}
	    if (args != NULL)
		fclose (args);
	}
	if (xflag[0] && (i = FindMac (xflag)) >= 0)
	    ExecuteBound (MacBodies[i]);
	do {
	    ProcessKeys ();
	    if (feof (InputFD)) {
		fprintf (stderr, "Exiting due to EOF -- files checkpointed\n");
		CheckpointEverything ();
		SilentlyExitEmacs++;
#ifdef subprocesses
		SilentlyKillProcesses++;
#endif
	    }
	}
	while ((	!SilentlyExitEmacs
			&& (modbufcount = ModExist())
			&& (*getnbstr (
"%d modified buffer%s exist%s, do you really want to exit? ",
			    modbufcount, modbufcount == 1 ? "" : "s",
			    modbufcount == 1 ? "s" : "")
			& 0137) != 'Y'
		)
#ifdef subprocesses
		|| (!SilentlyKillProcesses && count_processes() && (*getnbstr(
"You have processes still on the prowl, shall I chase them down for you? "
			) & 0137) != 'Y')
#endif
	    );
    }
    if (!dontremember)
    {
	register struct window *w;
	args = 0;
	for (w = windows; w; w = w -> w_next)
	    if ((SetBfp (w -> w_buf), bf_cur -> b_fname)
		    && strcmpn (bf_cur -> b_fname, "/tmp/", 5)) {
		if (args == 0)
		    args = fopen (sprintf (combuf, ".emacs_%d", getuid ()), "w");
		if (args == 0)
		    args = (FILE *) - 1;
		if (args != NULL)
		    fprintf (args, "%s\001%d\n", bf_cur -> b_fname,
			    w == wn_cur ? dot : ToMark (w -> w_dot));
	    }
    }
    {
	register struct buffer *b;

	for (b = buffers; b; b = b -> b_next)
	    DeleteBuffersCheckpointFile (b);
    }
    quit (0, 0);
}

#ifdef DumpableEmacs
/*
 * When Emacs is saved, there will be certain static variables which
 * need to be set to 0 so that they will be properly re-initialized
 * when Emacs is restarted.  The subroutine FluidStatic will add these
 * statics to a list, and they will be set to 0 when Emacs is dumped.
 */
struct init_static {
    struct init_static *next;
    char *where;
    int size;
};
static struct init_static *StaticList;

FluidStatic (var, size)
char *var;
{
    register struct init_static *s;

    for (s = StaticList; s; s = s -> next)
	if (s -> where == var)
	    return;
    s = (struct init_static *) malloc (sizeof *s);
    s -> next = StaticList;		/* Link into list */
    StaticList = s;
    s -> where = var;
    s -> size = size;
}

/* Dump the current Emacs using unexec() */
DumpEmacs () {
    register char *new_name, *a_name, *cp;
    register struct init_static *s;

    new_name = getstr (": dump-emacs (into) ");
    if (new_name == NULL)
	return 0;
    new_name = savestr (new_name);
    a_name = getstr (": dump-emacs (into) %s (from) ", new_name);
    if (a_name == NULL) {
	free (new_name);
	return 0;
    }
    if (*a_name == 0)
	a_name = NULL;

#ifdef subprocesses
    /* Clean up the Emacs session of subproc cruft */
    kill_processes ();
    flush_all_processes ();
#endif
    RstDsp ();
    QuitMpx ();
#ifdef OneEmacsPerTty
    UnlockTty ();
#endif
    fflush (stdout);
    setbuf (stdout, NULL);

    for (s = StaticList; s; s = s -> next)	/* zap the statics */
	for (cp = s -> where + s -> size; cp > s -> where; )
	    *--cp = 0;

    unexec (new_name, a_name, 0, 0);

    exit (0);
}
#endif

errlog.c        508005722   1094  1000  100644  3153      `
/* Routines for parsing an error log */

/*		Copyright (c) 1981,1980 James Gosling		*/

#include "buffer.h"
#include "config.h"
#include "window.h"
#include "keyboard.h"
#include "search.h"

struct err {			/* a single error message */
    struct marker  *e_mess;	/* points to the error message */
    struct marker  *e_text;	/* points to the position in the text
				   where the compiler thinks the error
				   is */
    struct err *e_next;		/* the next error in the chain */
};

static struct err
                   *errors,	/* the list of all error messages */
                   *ThisErr;	/* the current error */

/* delete the error list */
DelErl () {
    register struct err *e;
    while (errors) {
	e = errors;
	DestMark (e -> e_mess);
	DestMark (e -> e_text);
	errors = e -> e_next;
    }
}

/* Parse error messages from the current buffer from character pos to limit */
ParseErb (pos, limit)
register pos; {
    register struct buffer *erb = bf_cur;
    char old_fn[MaxPathNameLen];
    int old_ln = -1;
    struct search_globals lglobals;

    DelErl ();
    lglobals = search_globals;		/* Save the old search string */
    for (;;) {
	register    ln = 0;
	char    fn[MaxPathNameLen];
	register    fnend;
	register char  *p,
	                c;
	int     fnl = 0,
	        quoted = 0,
	        bol;
	SetBfp (erb);
	pos = search (", line ", 1, pos, 0);
	if (pos <= 0 || pos >= limit) {
	    search_globals = lglobals;	/* Restore old search string */
	    ThisErr = 0;
	    return errors != 0;
	}
	fnend = pos - 8;
	while (pos <= NumCharacters && (c = CharAt (pos)) >= '0' && c <= '9'){
	    pos++;
	    ln = ln * 10 + c - '0';
	}
	if (ln == 0)
	    continue;
	if (CharAt (fnend) == '"')
	    quoted++, fnend--;
	while (fnend >= 1) {
	    c = CharAt (fnend);
	    if (quoted) {
		if (c == '"') {
		    fnend++;
		    break;
		}
	    }
	    else
		if (c <= ' ') {
		    fnend++;
		    break;
		}
	    fnl++;
	    if(fnend<=1) break;
	    fnend--;
	}
	if (fnl == 0)
	    continue;
	for (p = fn; --fnl >= 0; fnend++)
	    *p++ = CharAt (fnend);
	*p++ = 0;
	if (old_ln == ln && strcmp (old_fn, fn)==0)
	    continue;
	old_ln = ln;
	strcpy (old_fn, fn);
	bol = ScanBf ('\n', fnend, -1);
	if (!VisitFile (fn, 0, 0))
	    continue;
	if (errors) {
	    ThisErr -> e_next
		= (struct err  *) malloc (sizeof (struct err));
	    ThisErr = ThisErr -> e_next;
	}
	else
	    errors = ThisErr
		= (struct err  *) malloc (sizeof (struct err));
	ThisErr -> e_next = 0;
	ThisErr -> e_mess = NewMark ();
	ThisErr -> e_text = NewMark ();
	SetMark (ThisErr -> e_mess, erb, bol);
	SetMark (ThisErr -> e_text, bf_cur, ScanBf ('\n', 1, ln - 1));
    }
}

/* move to the next error message in the log */
NextErr () {
    register    n;
    if (!errors) {
	error ("No errors!");
	return 0;
    }
    if (ThisErr == 0)
	ThisErr = errors;
    else {
	ThisErr = ThisErr -> e_next;
	if (ThisErr == 0) {
	    error ("No more errors...");
	    return 0;
	}
    }
    n = ToMark (ThisErr -> e_mess);
    WindowOn (bf_cur);
    SetDot (n);
    SetMark (wn_cur -> w_start, bf_cur, dot);
    n = ToMark (ThisErr -> e_text);
    WindowOn (bf_cur);
    SetDot (n);
    return 1;
}

filecomp.c      509368517   1094  1000  100644  12185     `
/* File completion routines */

/* Original code by Chris Torek <chris@umcp-cs>

 * Modifications for 4.1[ac]BSD by Marshall Rose <mrose@uci>
   If you want the 4.1[ac]BSD version, #define LIBNDIR.
   Note that this introduces the new global variable fast-file-searches.

 */

#include "config.h"
#include "window.h"
#include "buffer.h"
#include "keyboard.h"
#include "mlisp.h"
#include <sys/types.h>
#include <sys/dir.h>
#include <sys/stat.h>

#define DONE		0
#define CONTIN		1
#define GARBAGE		2
#define CANTHELP	3
#define EMPTY		4
#define MANY		5

#define min(a,b) ((a)<(b)?(a):(b))
#ifdef	LIBNDIR
#define max(a,b) ((a)>(b)?(a):(b))
#define	WID	18
#define	NCOLS	78
#endif

#ifndef	LIBNDIR
static char path[MaxPathNameLen], file[DIRSIZ];
#else
static char path[MaxPathNameLen], file[MAXNAMLEN];
#endif
static struct stat st;
static DirUsed;			/* Number of entries in DirEnts */
static unsigned DirSize;	/* Number of bytes allocated to DirEnts */
static DirSorted;		/* True iff table has been sorted */
static DirMatches;		/* Number of matches */
static MatchSize;		/* Number of characters matched */
static time_t	DirMtime;	/* st_mtime of current in-core dir */
static dev_t	DirDevice;	/* st_dev of current dir */
static ino_t	DirInode;	/* st_ino of current dir */
static struct direct *DirEnts;	/* The first entry */
static struct direct *FirstMatch;/* The first entry matching desired name */

extern int AutoHelp;
extern	PopUpWindows;
extern	RemoveHelpWindow;
static	struct	window *killee;

#ifdef	LIBNDIR
extern	FastFileSearches;
#endif

char *malloc (), *realloc (), *index (), *rindex ();

/* Get the name of some existing file */

char *
GetFileName (prompt)
char *prompt;
{
    static char result[MaxPathNameLen];
    register char *name = "";
    register f, len;
    int	oldpop = PopUpWindows;
    struct buffer *old = bf_cur;

    if (RemoveHelpWindow)
	PopUpWindows = 0;
    killee = 0;
    *result = 0;
    for (;;) {
	name = BrGetstr (1, result, &prompt);
	if (name == 0) {
	    if (killee)
		WindowOn (old);
	    PopUpWindows = oldpop;
	    return name;
	}
	f = name[strlen(name)-1] == DIRDELIMC;
	abspath (name, result);
	name = result;
	len = strlen (name);
	if (f) {
	    name[len++] = DIRDELIMC;
	    name[len] = 0;
	}
	if (LastKeyStruck == '?') {	/* Show possible completions */
	    name[len - 1] = 0;
	    SplitPath (name, path, file);
	    if (ReadDir (path) == 0) {
		MarkDir (file);
		showchoices ("Choose one of these:\n");
	    }
	    else
		Ding ();
	}
	else switch (PerformCompletion (name)) {
	    case DONE:		/* we got a file */
		if (killee)
	            WindowOn (old);
		PopUpWindows = oldpop;
		return name;
	    case GARBAGE:	/* foo on you */
		if (AutoHelp) {
		    ReadDir (path);
		    MarkDir (file);
		    showchoices ("Garbage!!  Use one of the following:\n");
		} else
		    Ding ();
		continue;
	    case CONTIN:	/* completed something */
		continue;
	    case CANTHELP:	/* directory unreadable */
		Ding ();
		continue;
	    case EMPTY:		/* empty directory */
		if (AutoHelp)
		    showchoices ("Empty directory!\n");
		Ding ();
		continue;
	    case MANY:		/* matches a bunch of names */
		if (AutoHelp) {
		    MarkDir (file);
		    showchoices ("Ambiguous, use one of the following:\n");
		}
		else
		    Ding ();
		continue;
	}
    }
}

static
PerformCompletion (name)
register char *name;
{
    register diving = 0;
    register pathlen;		/* Quick index into path or name */

top:
    if (stat (name, &st) == 0 && (st.st_mode & S_IFDIR) == 0)
	return DONE;		/* Got a filename */

    SplitPath (name, path, file);
#ifndef apm
    if (stat (path, &st) || (st.st_mode & S_IFDIR) == 0) {
	do {
	    register char *p = path;
	    while (*p++) ;
	    p[-2] = 0;		/* Remove trailing slash */
	    SplitPath (path, path, file);
	}
	while (stat (path, &st) || (st.st_mode & S_IFDIR) == 0);
	strcpy (name, path);
	return GARBAGE;		/* No such directory */
    }
    if (access (path, 4) < 0)	/* Cant read directory */
	return diving ? CONTIN : CANTHELP;
#endif
    if (ReadDir (path)) {	/* "Can't happen" */
	Ding ();
	return CONTIN;
    }
    if (DirUsed == 0)
	return EMPTY;		/* Empty directory */
    pathlen = strlen (path);
    MarkDir (file);
    if (DirMatches == 0) {	/* No such file */
	do file[--MatchSize] = 0;
	while (MarkDir (file) == 0);
	strcpy (name+pathlen, file);
	return GARBAGE;
    }
    if (DirMatches == 1) {	/* Exact match on one name */
	diving++;
#ifndef	LIBNDIR
	strncpy (name+pathlen, FirstMatch -> d_name, DIRSIZ);
	*(name+pathlen+DIRSIZ) = 0;
#else				/* already null terminated */
	strcpy (name+pathlen, FirstMatch -> d_name);
#endif
#ifndef apm
	if (stat (name, &st) == 0 && st.st_mode & S_IFDIR)
	    strcat (name, DIRDELIMS);
#endif
	goto top;
    }
/*
 * Make the name as long as possible such that it still matches the
 * same entries.  If we cannot add anything then the name was ambiguous.
 */
    {
	register oDirMatches = DirMatches, extended = 0;

	while (file[MatchSize] = FirstMatch -> d_name[MatchSize]) {
	    MatchSize++;
#ifndef	LIBNDIR
	    if (MatchSize < DIRSIZ)
		file[MatchSize] = 0;
#else
	    if (MatchSize < MAXNAMLEN)
		file[MatchSize] = 0;
#endif
	    if (MarkDir (file) < oDirMatches) {
		file[--MatchSize] = 0;
		break;
	    }
	    extended++;
	}
#ifndef	LIBNDIR
	strncpy (name+pathlen, file, DIRSIZ);/* (current path is correct) */
#else
	strcpy (name+pathlen, file);
#endif
	return extended || diving ? CONTIN : MANY;
    }
}

/* Make the table by reading the directory.  Return 0 if everything goes
   well.  Also, remember current table and only remake if new. */

#ifndef	LIBNDIR
static
ReadDir (dir)
char *dir;
{
    static lastrv;
    register struct direct *d, *p;
    register char *s;
    register f, l;

    f = open (dir, 0);
    if (f < 0)
	return lastrv = -1;
    fstat (f, &st);
    if (st.st_mtime == DirMtime && st.st_dev == DirDevice
			&& st.st_ino == DirInode) {
	close (f);
	return lastrv;
    }
    DirMtime = st.st_mtime;
    DirDevice = st.st_dev;
    DirInode = st.st_ino;
    if (st.st_size >= DirSize) {
	if (DirEnts)
	    free ((char *) DirEnts);
	DirSize = st.st_size + 30;
	DirEnts = (struct direct *) malloc (DirSize);
    }
    DirSorted = 0;
    lastrv = read (f, (char *) DirEnts, st.st_size + 1) != st.st_size;
    close (f);
    if (lastrv)
	return lastrv;
    p = DirEnts;
    d = DirEnts;
    for (f = st.st_size / sizeof *p; --f >= 0; p++) {
	if (p -> d_ino == 0)
	    continue;
	s = p -> d_name;
	if (s[0] == '.' && (s[1] == 0 || (s[1] == '.' && s[2] == 0)))
	    continue;
	l = DIRSIZ;
	while (*s++ && --l >= 0);
	--s;
	switch (*--s) {
	    case 'o':
		if (*--s == '.')
		    continue;
	    case 'P':
		if (*--s == 'K' && *--s == 'C' && *--s == '.')
		    continue;
	    case 'k':
		if (*--s == 'a' && *--s == 'b' && *--s == '.')
		    continue;
	}
	*d++ = *p;
    }
    DirUsed = d - DirEnts;
    return 0;
}
#else
static
ReadDir (dir)
char *dir;
{
    static int  lastrv;
    register int    f,
                    g,
                    l;
    register char  *e,
                   *s;
    short   byte;		/* 16 bits (I hope) */
    static char filnam[MaxPathNameLen];
    register struct direct *d,
                           *p;
    register    DIR * dd;

    if ((dd = opendir (dir)) == NULL)
	return (lastrv = -1);
#ifndef apm
    fstat (dd -> dd_fd, &st);
    if (st.st_mtime == DirMtime
	    && st.st_dev == DirDevice
	    && st.st_ino == DirInode) {
	closedir (dd);
	return lastrv;
    }
    DirMtime = st.st_mtime;
    DirDevice = st.st_dev;
    DirInode = st.st_ino;
#endif

    for (f = 0; p = readdir (dd); f++)
	continue;
again: ;
    f += 10;			/* fudge factor... */
    l = f * sizeof (struct direct);
    if (l >= DirSize) {
	if (DirEnts)
	    free ((char *) DirEnts);
	DirSize = l * 2;	/* why not? */
	DirEnts = (struct direct   *) malloc (DirSize);
    }

    DirSorted = 0;
    rewinddir (dd);
    for (d = DirEnts, g = 0; p = readdir (dd);) {
	if ((p -> d_namlen == 1 && !strcmp (p -> d_name, "."))
		|| (p -> d_namlen == 2 && !strcmp (p -> d_name, "..")))
	    continue;
	s = p -> d_name + p -> d_namlen;
	if (p -> d_namlen > 2 && !strcmp (s - 2, ".o"))
	    continue;
	if (p -> d_namlen > 4 && !strcmp (s - 4, ".mob"))
	    continue;
#ifdef	PrependExtension
	e = CheckpointExtension;
	if (!strncmp (p -> d_name, e, strlen (e)))
	    continue;
	e = BackupExtension;
	if (!strncmp (p -> d_name, e, strlen (e)))
	    continue;
#else
	if ((p -> d_namlen > (l = strlen (e = CheckpointExtension))
		    && !strcmp (s - l, e))
		|| ((p -> d_namlen > (l = strlen (e = BackupExtension))
			&& !strcmp (s - l, e))))
	    continue;
#endif
#ifndef apm
	if (FastFileSearches)
	    goto no_tricks;
	sprintfl (filnam, sizeof filnam, "%s/%s", dir, p -> d_name);
	if (stat (filnam, &st))
	    continue;
	if ((st.st_mode & S_IFDIR) != 0)
	    l = -1;
	else
	    if ((l = open (filnam, 0)) < 0)
		continue;
	if (l >= 0) {
	    if (read (l, (char *) (&byte), sizeof byte) != sizeof byte)
		byte = 0;
	    close (l);
	    switch (byte) {	/* is it a text file? */
		case 0405: 
		case 0407: 	/* OMAGIC */
		case 0410: 	/* NMAGIC */
		case 0411: 
		case 0413: 	/* ZMAGIC */
		case 0177545: 
		    continue;

		default: 	/* perhaps it is... */
		    break;
	    }
	}

no_tricks: ;
#endif
	if (f <= g++) {		/* directory grew!!! */
	    for (f = g; p = readdir (dd); f++)
		continue;
	    goto again;
	}
	d -> d_ino = p -> d_ino;
	d -> d_reclen = sizeof (struct direct);
	d -> d_namlen = p -> d_namlen;
	strcpy (d -> d_name, p -> d_name);
	d++;
    }
    closedir (dd);
    DirUsed = d - DirEnts;
    return (lastrv = 0);
}
#endif

/* Mark all the table entries that match 'string' */
static
MarkDir (string)
char *string;
{
    register struct direct *p;
#ifndef	LIBNDIR
    register len = DIRSIZ;
    register char *s = string;
#endif

#ifndef	LIBNDIR
    while (*s++ && --len >= 0) ;
    MatchSize = s - string - 1;
#else
    MatchSize = min (strlen (string), MAXNAMLEN);
#endif
    DirMatches = 0;
    for (p = &DirEnts[DirUsed - 1]; p>=DirEnts; p--)
	if (MatchSize == 0 || p->d_name[0]==string[0]
			&& strcmpn(p->d_name,string,MatchSize)==0) {
	    DirMatches++;
	    p -> d_ino = 1;
	    FirstMatch = p;
	} else p->d_ino = 0;
    return DirMatches;
}

/* Compare two table entries (for qsort) */

static
DirCompare (p1, p2)
register struct direct *p1, *p2;
{
#ifndef	LIBNDIR
    return strcmpn (p1 -> d_name, p2 -> d_name, DIRSIZ);
#else
    return strncmp (p1 -> d_name, p2 -> d_name,
	max (p1 -> d_namlen, p2 -> d_namlen));
#endif
}

/* Write all the matched entries into "Help" buffer.  Sort first
   if needed. */
static
showchoices (msg)
char *msg;
{
    register struct direct *p;
    register i;
#ifndef	LIBNDIR
    register side = 0;
    char buf[22];
#else
    register pos, j;
    char buf[MAXNAMLEN + WID];
#endif

    if (DirUsed > 1 && !DirSorted)
	qsort (DirEnts, DirUsed, sizeof (struct direct), DirCompare);
    DirSorted++;
    SetBfn ("Help");
    WindowOn (bf_cur);
    EraseBf (bf_cur);
    InsStr (msg);
    killee = wn_cur;
#ifndef	LIBNDIR
    for (p = DirEnts, i=DirUsed; --i>=0; p++) {
	if (p -> d_ino) {
	    sprintfl (buf, sizeof buf, (side==3 ? ((side=0), "%.*s\n")
		  : (side++, "%-18.*s")), DIRSIZ, p -> d_name);
	    InsStr (buf);
	}
    }
#else
    for (p = DirEnts, i = DirUsed, pos = 0; --i >= 0; p++)
	if (p -> d_ino) {
	    if (pos > 0) {
		if (pos + (j = WID - (pos % WID)) + p -> d_namlen > NCOLS)
		    pos = j = 0, InsStr ("\n");
	    }
	    else
		j = 0;
	    sprintfl (buf, sizeof buf, "%*s%.*s", j, "",
		    p -> d_namlen, p -> d_name);
	    InsStr (buf);
	    pos += p -> d_namlen +j;
	}
#endif
    BeginningOfFile ();
    bf_cur -> b_mode.md_NeedsCheckpointing = 0;
    bf_modified = 0;
}

/* Split a pathname into directory and filename components */
static SplitPath (path, dir, file)
register char *path;
char *dir, *file; {
    register char *p, *d = 0;

    for (p = path; *p; ) if (*p++ == DIRDELIMC) d = p;
    if (d) {
	strncpy (dir, path, d - path);
	dir[d-path] = 0;
#ifndef	LIBNDIR
	strncpy (file, d, DIRSIZ);
#else
	strncpy (file, d, MAXNAMLEN);
#endif
    } else {
	dir[0] = 0;
#ifndef	LIBNDIR
	strncpy (file, path, DIRSIZ);
#else
	strncpy (file, path, MAXNAMLEN);
#endif
    }
}

fileio.c        508005723   1094  1000  100644  17970     `
/* File IO for Emacs */

/*		Copyright (c) 1981,1980 James Gosling		*/

#include "keyboard.h"
#include "mlisp.h"
#include "buffer.h"
#include "window.h"
#include "config.h"
#include "macros.h"
#include <sys/types.h>
#include <sys/stat.h>

char *GetFileName();

struct AutoMode {		/* information for automatic mode
				   recognition */
    char   *a_pattern;		/* the pattern that the name must match */
    int     a_len;		/* the length of the pattern string */
    struct BoundName *a_what;	/* what to do if we find it */
    struct AutoMode *a_next;	/* the next thing to try */
};

static struct AutoMode *AutoList;/* the list of filename-pattern pairs that
				    have been specified by auto-execute */
static FilesShouldEndWithNewline;/* If true, then if the user trys to write
				    out a buffer that doesn't end in a
				    newline then they'll get asked about it.
				    I almost called this variable
				    "kazar-mode" but good taste prevaled */
static BackupBeforeWriting;	/* if true, then file being written will be
				   backed up just before the first time that
				   it is written. */
static BackupByCopying;		/* if true, then when a backup is made, it
				   will be made by copying the file, rather
				   than by fancy footwork with links (this
				   is for folks who like to preserve links
				   to files) */
static BackupByCopyingWhenLinked;/* if true, then when a backup for a file
				    with multiple links is made, it will be
				    made by copying */
static UnlinkCheckpointFiles;	/* if true, then when a file is written out
				   the corresponding checkpoint file is
				   deleted -- some people don't like to have
				   .CKP files cluttering up their
				   directories, but some people like the
				   added security. */
static AskAboutBufferNames;	/* If true (the default) Emacs will ask
				   instead of synthesizing a unique name in
				   the case where visit-file encounters a
				   conflict in generated buffer names. */
#ifdef LIBNDIR
int FastFileSearches;		/* If true (the default) then Emacs will
				   not perform any fancy tests to determine
				   what files the user is interested in
				   during filename command completion */
#endif LIBNDIR
static Umask;			/* the current umask() */

DoAuto (filename)		/* Perform the auto-execute action (if any)
				   for the specified filename */
char   *filename; {
    register struct AutoMode   *p;
    register    len = strlen (filename);
    register saverr = err;
    err = 0;
    for (p = AutoList; p; p = p -> a_next)
	if ( len+1 >= p->a_len && (*p -> a_pattern == '*'
		    ? strcmpn (p -> a_pattern + 1,
			filename + len - p -> a_len + 1,
			p -> a_len - 1)
		    : strcmpn (p -> a_pattern, filename, p -> a_len - 1)
		) == 0) {
	    ExecuteBound (p->a_what);
	    break;
	}
    err |= saverr;
}

AutoExecute () {
    int     what = getword (MacNames, ": auto-execute ");
    char   *pattern;
    register struct AutoMode   *p;
    if (what < 0)
	return 0;
    pattern = getstr (": auto-execute %s when name matches ",
	    MacNames[what]);
    if (pattern == 0)
	return 0;
    if ((*pattern == '*') == (pattern[strlen (pattern) - 1] == '*'))
	error ("Improper pattern \"%s\"; should either be of the form \"*X\" or \"X*\"", pattern);
    else {
	p = (struct AutoMode   *) malloc (sizeof *p);
	p -> a_pattern = savestr (pattern);
	p -> a_len = strlen (p -> a_pattern);
	p -> a_what = MacBodies[what];
	p -> a_next = AutoList;
	AutoList = p;
    }
    return 0;
}

static PerformAutoMode () {
    if (CurExec && CurExec -> p_nargs) {
	StringArg (1);
	if (err) return 0;
	DoAuto (MLvalue -> exp_v.v_string);
	ReleaseExpr (MLvalue);
    }
    else
	DoAuto (bf_cur -> b_name);
    return 0;
}

static
WriteFileExit () {
    return ModWrite () ? -1 : 0;
}

/* Call with pointer to buffer whose checkpoint file may be deleted. */

DeleteBuffersCheckpointFile (b)
register struct buffer *b;
{
    if (UnlinkCheckpointFiles) {
	if (b -> b_checkpointfn)
	    unlink (b -> b_checkpointfn);
	b -> b_checkpointed = 0;
    }
}

static  WriteThis () {
    register    rv = 0;
    if (!bf_cur -> b_fname)
	error ("No file name assocated with buffer");
    else
	if (WriteFile (bf_cur -> b_fname, 0))
	    rv = -1;
    if (UnlinkCheckpointFiles) {
	if (!err && bf_cur -> b_checkpointfn)
	    unlink (bf_cur -> b_checkpointfn);
	bf_cur -> b_checkpointed = 0;
    }
    return rv;
}

static InsertFile () {
    char *fn = GetFileName("Insert file: ");

    if (fn) {
	readfile (SaveAbs (fn), 0, 0);
	bf_modified++;
    }
    return 0;
}

static
WriteModifiedFiles () {
    ModWrite ();
    return 0;
}

static
ReadFile () {
    register char  *fn = getstr (": read-file ");
    if (fn == 0)
	return 0;
    readfile (SaveAbs(*fn ? fn : bf_cur->b_fname), 1, 0);
    DoAuto (fn);
    return 0;
}

static
UnlinkFile () {
    register char *fn = (char *) SaveAbs (getstr (": unlink-file "));
    MLvalue -> exp_int = fn ? unlink (fn) : -1;
    MLvalue -> exp_type = IsInteger;
    return 0;
}

static
FileExists () {
    register char *fn = (char *) SaveAbs (getstr (": file-exists "));
    if (fn==0) return 0;
    MLvalue -> exp_int = *fn == 0 ? 0
		: access (fn, 2)>=0 ? 1
		: access(fn, 4)>=0 ? -1
		: 0;
    MLvalue -> exp_type = IsInteger;
    return 0;
}

static
WriteCurrentFile () {
    if (!bf_cur -> b_fname)
	error ("No file name assocated with buffer");
    else
	WriteFile (bf_cur -> b_fname, 0);
    if (UnlinkCheckpointFiles) {
	if (!err && bf_cur -> b_checkpointfn)
	    unlink (bf_cur -> b_checkpointfn);
	bf_cur -> b_checkpointed = 0;
    }
    return 0;
}

static  VisitFileCommand () {
    VisitFile (getstr ("Visit file: "), 1, 1);
    return 0;
}

static	VisitExistingFileCommand () {
    VisitFile (GetFileName ("Visit existing file: "), 1, 1);
    return 0;
}

static	SetFileName () {
    register char *fn = getstr (": set-file-name to ");
    if (fn == 0 || *fn == 0)
	return 0;
    if (bf_cur -> b_fname)
	free (bf_cur -> b_fname);
    bf_cur -> b_fname = savestr ((char *) SaveAbs (fn));
    Cant1WinOpt++;
    bf_cur -> b_kind = FileBuffer;
    return 0;
}

static  WriteNamedFile () {
    register char  *fn = getstr ("Write file: ");
    if (fn == 0)
	return 0;
    if (*fn == '\0') {
	if (bf_cur -> b_fname == 0) {
	    error ("I don't like empty file names!");
	    return 0;
	}
    }
    else {
	if (bf_cur -> b_fname)
	    free (bf_cur -> b_fname);
	bf_cur -> b_fname = savestr ((char *) SaveAbs (fn));
    }
    if (bf_cur -> b_checkpointfn) {
	free (bf_cur -> b_checkpointfn);
	bf_cur -> b_checkpointfn = 0;
	bf_cur -> b_checkpointed = 0;
    }
    Cant1WinOpt++;
    bf_cur -> b_kind = FileBuffer;
    WriteCurrentFile ();
    return 0;
}

static  AppendToFile () {
    register char  *fn = getstr (": append-to-file ");
    char fnbuf[MaxPathNameLen];	/* if only C had real strings...  Then I
				   wouldn't have to resort to returning
				   strings in static & getting bitten by
				   later overwrites. */
    if (fn == 0)
	return 0;
    if (*fn=='\0'){
	error("I don't like empty file names!");
	return 0;
    }
    strcpy(fnbuf, SaveAbs (fn));
    WriteFile (fnbuf, 1);
    return 0;
}

VisitFile (fn, CreateNew, WindowFiddle)
char   *fn; {
    char    fullname[MaxPathNameLen];
    register struct buffer *b,
                           *oldb = bf_cur;
    if (fn == 0 || *fn == 0)
	return 0;
    strcpy (fullname, SaveAbs (fn));
    for (b = buffers;
	    b && (b -> b_fname == 0 || strcmp (fullname, b -> b_fname) != 0);
	    b = b -> b_next);
    if (b)
	SetBfp (b);
    else {
	char   *bufname;
	register char  *p = fullname;
	bufname = fullname;
	while (*p)
	    if (*p++ == DIRDELIMC && *p)
		bufname = p;
	if (FindBf (bufname)) {
	    if (interactive && AskAboutBufferNames) {
		p = getstr (
"Buffer name %s is in use, type a new name or <CR> to clobber: ", bufname);
		if (p == 0)
		    return 0;
		if (*p)
		    bufname = p;
	    }
	    else {
		static char SynthName[100];
		register    seq = 1;
	    /* I'm making the (perhaps) brash assumption that the
	       following loop is guaranteed to terminate.  To those who
	       think that this is an inefficient technique: you have
	       been deluded. */
		do sprintf (SynthName, "%s<%d>", bufname, ++seq);
		while (FindBf (SynthName));
		bufname = SynthName;
	    }
	}
	SetBfn (bufname);
	if (!readfile (fullname, 1, CreateNew) && !CreateNew) {
	    SetBfp (oldb);
	    return 0;
	}
	else {
	    bf_cur -> b_kind = FileBuffer;
	    if (bf_cur -> b_fname)
		free (bf_cur -> b_fname);
	    if (bf_cur -> b_checkpointfn)
		free (bf_cur -> b_checkpointfn);
	    bf_cur -> b_checkpointfn = 0;
	    bf_cur -> b_checkpointed = 0;
	    bf_cur -> b_fname = savestr (fullname);
	}
    }
    if (WindowFiddle) WindowOn (bf_cur);
    if (b == 0)
	DoAuto (fn);
    return 1;
}

readfile (fn, erase, CreateNew)
char   *fn; {
    struct stat st;
    register int    fd;
    register int    n,
                    i;
    if (fn == 0)
	return 0;
    if (*fn == 0) {
	error ("Aw come on, if you want me to read something I need file name");
	return 0;
    }
    if (stat (fn, &st) < 0 || (fd = open (fn, 0)) < 0) {
	error (CreateNew ? "New file: %s" : "Can't find \"%s\"", fn);
	return 0;
    }
    Cant1LineOpt++;
    RedoModes++;
    WidenRegion ();
    if (erase)
	EraseBf (bf_cur);
    GapTo (dot);
    DoneIsDone ();
    if (GapRoom (st.st_size))
	return 0;
    n = 0;
    while ((i = read (fd, bf_p1 + bf_s1 + 1 + n, st.st_size - n)) > 0)
	n += i;
    close (fd);
    if (n > 0) {
	bf_s1 += n;
	bf_gap -= n;
	bf_p2 -= n;
    }
    if (n == 0)
	message ("Empty file.");
    if (i < 0)
	error ("Error reading file \"%s\"", fn);
    if (erase) {
	if (bf_cur -> b_fname)
	    free (bf_cur -> b_fname);
	if (bf_cur -> b_checkpointfn) {
	    free (bf_cur -> b_checkpointfn);
	    bf_cur -> b_checkpointfn = 0;
	    bf_cur -> b_checkpointed = 0;
	}
	bf_cur -> b_fname = savestr (fn);
	bf_cur -> b_kind = FileBuffer;
    }
    return i >= 0;
}

/* Given a file name and an extension to be forced, concoct a new file name
   which is their concatenation, accounting for the restricton on the length
   of the last component of a file name begin 14 characters. */
char *ConcoctName (fn, extension)
char *fn, *extension;
{
    static  char name[MaxPathNameLen];
#ifdef PrependExtension
    register    extlen;
#endif
    register char  *p,
                   *s,
                   *tail;
#ifdef PrependExtension
    for (p = extension, extlen = 0; *p++;)
	extlen++;
#endif
    for (s = fn, p = tail = name; *p = *s++; p++)
	if (*p == DIRDELIMC)
	    tail = p + 1;
#ifdef PrependExtension
    /* put the extension at the beginning and let system truncate
     * name
     */
    for( ; p >= tail ; *(p+extlen) = *p, p-- );	/* shift right */
    for( p = extension ; *p ; *tail++ = *p++);  /* insert extension */
#else
#ifdef apm
#define BASEMAX 8
#else
#define BASEMAX 10
#endif
    if (p - tail > BASEMAX)
	p = tail + BASEMAX;
    for(s=extension; *p++ = *s++; );
#endif
    return name;
}

/* write the current buffer to the named file; returns true iff
   successful.  Appends to the file if AppendIt is >0, does a checkpoint
   style write if AppendIt is <0. */
WriteFile (fn, AppendIt)
register char  *fn; {
    register    fd;
    register    nc = bf_s1 + bf_s2;
    int     mode = 0666 & ~Umask;
    int     TempFile =	   fn[0] == DIRDELIMC && fn[1] == 't' && fn[2] == 'm'
			&& fn[3] == 'p' && fn[4] == DIRDELIMC;
    if(AppendIt<0) mode = 0600 & ~Umask;
    if(AppendIt>=0 && !access(fn,0) && access(fn,2)) {
	error("File %s cannot be written",fn);
	return 0;
    }
    if (fn == 0 || *fn == 0)
	return 0;

    /* (ACT) Dont write if ReadOnly */

    if (AppendIt >= 0 && bf_mode.md_ReadOnly) {
	error ("File %s is read-only", fn);
	return 0;
    }

    if (AppendIt>0) {
	fd = open (fn, 1);
	if (fd < 0)
	    fd = creat (fn, mode);
	if (fd >= 0)
	    if (lseek (fd, 0, 2) < 0)
		close (fd), fd = -1;
    }
    else {
	if (AppendIt>=0 && BackupBeforeWriting && !TempFile
		&& !bf_cur -> b_BackedUp) {
	    struct stat st;
	    char    *name = ConcoctName (fn, BackupExtension);
	    bf_cur -> b_BackedUp++;
	    if (stat (fn, &st) == 0)
		mode = st.st_mode;
	    if (BackupByCopying
		    || st.st_nlink>1 && BackupByCopyingWhenLinked) {
		int     ifd,
		        ofd = -1,
		        n;
		char    buf[2048];
		if ((ifd = open (fn, 0)) >= 0
			&& (ofd = creat (name, 0600)) >= 0)
		    while ((n = read (ifd, buf, sizeof buf)) > 0)
			write (ofd, buf, n);
		if (ifd >= 0)
		    close (ifd);
		if (ofd >= 0)
		    close (ofd);
	    }
	    else {
		unlink (name);
		link (fn, name);
		unlink (fn);
	    }
	}
	fd = creat (fn, mode);
	if (fd >=0 && (mode & ~Umask) != mode)
	    chmod (fn,mode);
    }
    if (fd < 0) {
	error ("Can't write %s", fn);
	return 0;
    }
    if (FilesShouldEndWithNewline
	&& nc > 0 && CharAt (nc) != '\n' && interactive && AppendIt>=0 &&
	    *getnbstr (
		"\"%s\" doesn't end with a newline, should I add one? ",
		bf_cur->b_name) == 'y')
	InsertAt (nc + 1, '\n');
    if (write (fd, bf_p1 + 1, bf_s1) < 0
	    || write (fd, bf_p1 + 1 + bf_s1 + bf_gap, bf_s2) < 0) {
	error ("IO error writing %s", fn);
	close (fd);
	return 0;
    }
    if(!err) {
	bf_modified = 0;
	bf_cur -> b_checkpointed = 0;
	if (!TempFile && AppendIt >= 0)/* (ACT) Don't message about CKP's */
	    message ("Wrote %s", fn);
    }
    close (fd);
    Cant1LineOpt++;		/* Force update of the mode line */
    return 1;
}

/* fopenp opens the file fn with the given IO mode using the given
   search path.  The actual file name is returned in fnb.  The search
   path is interpreted in the same way as the PATH environment variable
   is interpreted by exec?p().  This routine normally comes from the CMU
   C library, but since Emacs is being distributed I have to roll-my-own.
   */
FILE *
fopenp (path, fn, fnb, mode)
register char *path;
char *fn, *fnb, *mode;
{
    register FILE *fd;
    char AbsForm[MaxPathNameLen];
    register char  *dst,
                   *src;
    if (path == 0)
	path = "";
    if (*fn=='~') {
	abspath (fn, AbsForm);
	fn = AbsForm;
    }
#ifdef apm
    if (index(fn, DIRDELIMC)){
#else
    if (*fn==DIRDELIMC){
#endif
	if(( fd = fopen(fn, mode)) != NULL) {
	    strcpy(fnb, fn);
	    return fd;
	}
	return NULL;
    }
    do {
	dst = fnb;
	while (*path && *path != ':')
	    *dst++ = *path++;
	if (dst != fnb)
	    *dst++ = DIRDELIMC;
	for (src = fn; *dst++ = *src++;);
	if ((fd = fopen (fnb, mode)) != NULL)
	    return fd;
    } while (*path++);
    return NULL;
}

/* returns true if modified buffers exist */
ModExist () {
    register struct buffer *b;
    register modcount = 0;

    SetBfp (bf_cur);
    for (b = buffers; b; b = b -> b_next)
	if (b -> b_modified && b -> b_kind == FileBuffer)
	    modcount++;
    return modcount;
}

static
ModificationsExist () {
    MLvalue -> exp_int = ModExist();
    MLvalue -> exp_type = IsInteger;
    return 0;
}

/* write all modified buffers; return true iff OK */
ModWrite () {
    register struct buffer *b;
    struct buffer  *old = bf_cur;
    register WriteErrors = 0;
    for (b = buffers; b; b = b -> b_next) {
	SetBfp (b);
	if (bf_cur->b_kind==FileBuffer && bf_modified
	    && WriteThis () == 0
	    && 'y' != *getnbstr ("Can't write buffer %s, can I ignore it? ",
				b -> b_name)){
	    WriteErrors++;
	}
    }
    SetBfp (old);
    return !err && !WriteErrors;
}

static DisplayCheckpointMessage;/* if off, prevents message */

CheckpointEverything () {
    register struct buffer *b;
    struct buffer  *old = bf_cur;
    register    WriteErrors = 0, modcnt;
    int Checkpointed = 0;
    for (b = buffers; b; b = b -> b_next)
	if (b -> b_mode.md_NeedsCheckpointing
		&& b -> b_checkpointed < (modcnt = b == bf_cur ? bf_modified
						: b -> b_modified)) {
	    SetBfp (b);
	    if (b -> b_checkpointfn == 0)
		b -> b_checkpointfn =
		    savestr (ConcoctName (b -> b_fname ? b -> b_fname
						    : b -> b_name,
					  CheckpointExtension));
	    WriteErrors |= WriteFile (b -> b_checkpointfn, -1) == 0;
	    Checkpointed++;
	    b ->b_checkpointed = bf_modified = modcnt;
	}
    SetBfp (old);
    if(!WriteErrors && Checkpointed && DisplayCheckpointMessage)
	message("Checkpointed...");
    if (WriteErrors) err = 0;	/* to avoid having errors during checkpoints
				   blow away functions in the middle of
				   execution. */
    return 0;
}

InitFIO () {
    umask(Umask = umask(077));
#ifdef DumpableEmacs
    if (!Once)
#endif
    {
	DefIntVar ("backup-before-writing", &BackupBeforeWriting);
	DefIntVar ("backup-by-copying", &BackupByCopying);
	DefIntVar ("backup-by-copying-when-linked", &BackupByCopyingWhenLinked);
	DefIntVar ("unlink-checkpoint-files", &UnlinkCheckpointFiles);
	DefIntVar ("files-should-end-with-newline", &FilesShouldEndWithNewline);
	FilesShouldEndWithNewline = 1;
	DefIntVar ("ask-about-buffer-names", &AskAboutBufferNames);
	AskAboutBufferNames = 1;
	DefIntVar ("display-checkpoint-message", &DisplayCheckpointMessage);
	DisplayCheckpointMessage = 1;
#ifdef LIBNDIR
	DefIntVar ("fast-file-searches", &FastFileSearches);
	FastFileSearches = 1;
#endif LIBNDIR
	setkey (CtlXmap, (Ctl ('F')), WriteFileExit, "write-file-exit");
	setkey (CtlXmap, (Ctl ('R')), ReadFile, "read-file");
	setkey (CtlXmap, (Ctl ('I')), InsertFile, "insert-file");
	setkey (CtlXmap, (Ctl ('V')), VisitFileCommand, "visit-file");
	setkey (CtlXmap, (Ctl ('Q')), VisitExistingFileCommand, "visit-existing-file");
	setkey (CtlXmap, (Ctl ('W')), WriteNamedFile, "write-named-file");
	setkey (CtlXmap, (Ctl ('M')), WriteModifiedFiles, "write-modified-files");
	setkey (CtlXmap, (Ctl ('S')), WriteCurrentFile, "write-current-file");
	defproc (AppendToFile, "append-to-file");
	defproc (UnlinkFile, "unlink-file");
	defproc (FileExists, "file-exists");
	defproc (ModificationsExist, "modifications-exist");
	defproc (PerformAutoMode, "perform-automode-action");
	defproc (CheckpointEverything, "checkpoint");
	defproc (AutoExecute, "auto-execute");
	defproc (SetFileName, "set-file-name");
    }
}
keyboard.c      508005723   1094  1000  100644  10871     `
/* keyboard manipulation primitives */

/*		Copyright (c) 1981,1980 James Gosling		*/

#include "keyboard.h"
#include "window.h"
#include "buffer.h"
#include "config.h"
#include "mlisp.h"
#ifdef subprograms
#include "subprogram.h"
#endif
#include <sgtty.h>

#ifdef apm
#define IPEND(n)	(n = ipend())
#else
#ifdef FIONREAD
#define IPEND(n)	(ioctl(fileno(stdin), FIONREAD, &n))
#endif
#endif

#ifdef subprocesses
#include "mchan.h"
#endif

#ifdef CatchSig
#include <signal.h>
#endif

/* A keyboard called procedure returns:
	 0 normally
	-1 to quit */

static EndOfMac;		/* the place where the keyboard macro
				   currently being defined should end. */
static PushedBack;		/* The most recently pushed back character;
				   it will be returned by GetChar the next
				   time that GetChar is called */
static MetaPushBack;		/* The pushed-back meta key; it will be
				   returned by GetChar once PushedBack is
				   taken care of.  The idea is that if
				   the user hits Meta-Foo inside a
				   get-tty-character, get-tty-char will
				   return an ESC; this can be pushed back
				   and the meta key will still meta. */
static CheckpointFrequency;	/* The number of keystrokes between
				   checkpoints. */
static Keystrokes;		/* The number of keystrokes since the last
				   checkpoint. */
static CanCheckpoint;		/* True iff we're allowed to checkpoint
				   now. */
static char KeyBuf[10];		/* Buffer for keys from GetChar() */
static NextK;			/* Next index into KeyBuf */
static EchoKeys;		/* >= 0 iff we are to echo keystrokes */
static EchoArg;			/* >= 0 iff we are to echo arg */
static Echo1, Echo2;		/* Stuff for final echo */

#define	min(a,b)	((a)<(b)?(a):(b))

/* Echo the current keystrokes */
/* NOTE: DEPENDS ON POSITIVE ARGUMENT WHEN CALLED BY A SIGNAL */
EchoThem (notfinal)
register notfinal;
{
    char *dash = notfinal ? "-" : "";

    if (EchoArg >= 0 && ArgState != NoArg) {
	if (EchoKeys >= 0 && NextK)
	    message ("Arg: %d %s%s", arg, KeyToStr (KeyBuf, NextK), dash);
	else
	    message ("Arg: %d", arg);
    }
    else {
	if (EchoKeys >= 0 && NextK)
	    message ("%s%s", KeyToStr (KeyBuf, NextK), dash);
	else
	    return;
    }
    if (notfinal)
	Echo1++;		/* set echoed-flag */
    if (notfinal >= 0)
	DoDsp (0);
}

/* ProcessKeys reads keystrokes and interprets them according to the
   given keymap and its inferior keymaps */
ProcessKeys () {
    register struct keymap *m;
    static struct keymap    NullMap;
    register    c;
    NextGlobalKeymap = 0;
    NextLocalKeymap = 0;

    while (1) {
	if (NextGlobalKeymap == 0) {
	    if (Remembering)
		EndOfMac = MemUsed;
	    if (ArgState != HaveArg && MemPtr == 0 && bf_cur != minibuf)
		UndoBoundary ();
	}
	CanCheckpoint++;
	if (!InputPending && (EchoKeys == 0 || EchoArg == 0))
	    EchoThem (-1);
	if ((c = GetChar ()) < 0) {
	    CanCheckpoint = 0;
	    return 0;
	}
	if (NextK >= sizeof KeyBuf)
	    NextK = 0;
	KeyBuf[NextK++] = c;
	CanCheckpoint = 0;
	if (wn_cur -> w_buf != bf_cur)
	    SetBfp (wn_cur -> w_buf);
	if (NextGlobalKeymap == 0)
	    NextGlobalKeymap = CurrentGlobalMap;
	if (NextLocalKeymap == 0)
	    NextLocalKeymap = bf_mode.md_keys;
	if (m = NextLocalKeymap) {
	    register struct BoundName  *p;
	    NextLocalKeymap = 0;
	    if (p = m -> k_binding[c]) {
		LastKeyStruck = c & 0177;
		if (p -> b_binding != KeyBound) {
		    /* If echoed immediate preceding key, echo this one */
		    if (!InputPending && Echo2)
			EchoThem (0);
		    NextK = 0;
		    ThisCommand = LastKeyStruck;
		}
		if (ExecuteBound (p) < 0)
		    return 0;
		if (ArgState != HaveArg)
		    PreviousCommand = ThisCommand;
		if (NextLocalKeymap == 0) {
		    NextGlobalKeymap = 0;
		    continue;
		}
	    }
	}
	if (m = NextGlobalKeymap) {
	    register struct BoundName  *p;
	    register struct keymap *local;
	    local = NextLocalKeymap;
	    NextGlobalKeymap = 0;
	    NextLocalKeymap = 0;
	    if (p = m -> k_binding[c]) {
		LastKeyStruck = c & 0177;
		if (p -> b_binding != KeyBound) {
		    if (!InputPending && Echo2)
			EchoThem (0);
		    NextK = 0;
		    ThisCommand = LastKeyStruck;
		}
		if (ExecuteBound (p) < 0)
		    return 0;
		if (ArgState != HaveArg)
		    PreviousCommand = ThisCommand;
		if (NextLocalKeymap) {
		    NextGlobalKeymap = NextLocalKeymap;
		    NextLocalKeymap = local ? local : &NullMap;
		}
		else {
		    NextGlobalKeymap = local ? &NullMap : 0;
		    NextLocalKeymap = local;
		}
		continue;
	    }
	    else {
		NextGlobalKeymap = local ? &NullMap : 0;
		NextLocalKeymap = local;
	    }
	}
	if (NextLocalKeymap == 0) {
	    NextK = 0;
	    IllegalOperation ();
	}
	else
	    NextGlobalKeymap = &NullMap;
    }
}

/* read a character from the keyboard; call the redisplay if needed */
GetChar () {
    register c, alarmtime;

    if ((c = PushedBack) >= 0) {
	PushedBack = -1;
	goto HaveCharacter;
    }
    if ((c = MetaPushBack) >= 0) {
	MetaPushBack = -1;
	goto HaveCharacter;
    }
    if (MemPtr) {
	if (err) {
	    MemPtr = 0;
	    c = -1;
	    goto ReturnIt;
	}
	c = (unsigned char) *MemPtr++;
	if (c) {
	    c &= 0177;
	    goto HaveCharacter;
	}
	MemPtr = 0;
	c = -1;
	goto ReturnIt;
    }
    if (err && InputFD!=stdin) {
	c = -1;
	goto ReturnIt;
    }
    alarmtime = EchoKeys >= 0 ? (EchoArg >= 0 ? min (EchoKeys, EchoArg)
					      : EchoKeys)
			      : EchoArg;
#ifdef subprograms
    if (InputFD==stdin && !InputPending) {
#else
#ifdef subprocesses
    if (InputFD==stdin && mpxin->ch_count==0 && !InputPending) {
#else
     if (InputFD==stdin && stdin->_cnt==0 && !InputPending) {
#endif subprocesses
#endif subprograms
#ifdef IPEND
	IPEND(InputPending);
#endif
	if(!InputPending) {
	    DoDsp (0);
	    if(CheckpointFrequency>0 && CanCheckpoint
		    && Keystrokes>CheckpointFrequency) {
		CheckpointEverything ();
		Keystrokes = 0;
	    }
	}
    }
    Keystrokes++;
#ifdef subprograms
    if(InputFD == stdin) {
	extern int (*KeyBoardGet)();

	asm("	.text");
/*	trap(1111); */
	asm("	lea	[C_KBGret,.a4],.a0");
	asm("	movl	.a0,.sp@-");		/* push return address */
	asm("	moveml	#0xe0e0,.sp@-");	/* push d0-d2/a0-a2 */
	asm("	moveq	#1,.d1");
	asm("	movl	[C_KeyBoardGet,.a4],.a0");
	asm("	movl	.a0@,.a0");
	asm("	jmp	.a0@");
	asm("C_KBGret:	movl	.d0,.d7");	/* c = (*KeyBoardGet)(); */
	asm("	.data");
	asm("	.even");
	asm("C_KeyBoardGet:");
	asm("	.vect	\"C_KeyBoardGet\",.extdata");
	asm("	.text");

	IPEND(InputPending);
    }
    else {
	c = getc(InputFD);
	InputPending = stdin->_cnt>0;
    }
#else
#ifdef subprocesses
    if(InputFD == stdin) {
	c = mpx_getc(mpxin);
	InputPending = mpxin->ch_count;
    }
    else {
	c = getc(InputFD);
	InputPending = stdin->_cnt>0;
    }
#else
    {
	if (alarmtime > 0) {
	    signal (SIGALRM, EchoThem);
	    alarm ((unsigned) alarmtime);
	}
	c = getc(InputFD);
	alarm (0);
	InputPending = stdin->_cnt>0;
    }
#endif subprocesses
#endif subprograms
    if (c < 0) {
	c = -1;
	goto ReturnIt;
    }
HaveCharacter:
    if (Remembering) {
	KeyMem[MemUsed++] = (MetaFlag && (c&0200)) ? 033 : c | 0200;
	if (MemUsed >= MemLen) {
	    error ("Keystroke memory overflow!");
	    Remembering = EndOfMac = MemUsed = KeyMem[0] = 0;
	}
    }
    if (MetaFlag && (c&0200)) {
	MetaPushBack = c & 0177;
	c = 033;
    }
    c &= 0177;
ReturnIt:
    Echo2 = Echo1;		/* Save last echoed-flag */
    Echo1 = 0;			/* Clear echoed-flag */
    return c;
}

/* Given a keystroke sequence look up the BoundName that it is bound to */
struct BoundName **LookupKeys (map, keys, len)
register struct keymap *map;
register char *keys;
register len;
{
    register struct BoundName  *b;
    while (map && --len >= 0) {
	b = map -> k_binding[*keys];
	if (len == 0)
	    return &map -> k_binding[*keys];
	keys++;
	if (b == 0 || b -> b_binding != KeyBound)
	    break;
	map = b -> b_bound.b_keymap;
    }
    return 0;
}

static ExecutingKeyboardMacro;	/* true iff executing keyboard macro */

StartRemembering () {
    if (Remembering)
	error ("Already remembering!");
    else {
	Remembering++;
	ExecutingKeyboardMacro = 0;
	MemUsed = EndOfMac = 0;
	message("Remembering...");
    }
    return 0;
}

StopRemembering () {
    if (Remembering) {
	Remembering = 0;
	KeyMem[EndOfMac] = 0;
	message("Keyboard macro defined.");
    }
    return 0;
}

/* Execute the given command string */
ExecStr (s)
char *s; {
    register char  *old = MemPtr;
    MemPtr = s;
    ProcessKeys ();
    MemPtr = old;
}

ExecuteKeyboardMacro () {
    if (Remembering)
	error ("Sorry, you can't call the keyboard macro while defining it.");
    else if (MemUsed == 0)
	    error ("No keyboard macro to execute.");
    else if (ExecutingKeyboardMacro)
	    return 0;
    else {
	register i = arg;
	ExecutingKeyboardMacro++;
	arg = 0;
	ArgState = NoArg;
	do ExecStr (KeyMem);
	while (!err && --i>0);
	ExecutingKeyboardMacro = 0;
    }
    return 0;
}

static
PushBackCharacter () {
    register    n = (int) *getkey (&GlobalMap, ": push-back-character ");
    if (!err)
	PushedBack = n;
    return 0;
}

RecursiveEdit () {
    struct ProgNode *oldp = CurExec;
    register FILE *oldf = InputFD;
#ifdef subprograms
    register struct InputNode *inp = &SPInput;
    PFI oldin = InputRoutine;
    PFI oldout = OutputRoutine;
    struct InputNode oldspi;
    oldspi = *inp;
    ClearSPI;
    ConnectInput(NULLFUNC);
    ConnectOutput(NULLFUNC);
#endif
    InputFD = stdin;
    CurExec = 0;
    RecurseDepth++;
    Cant1LineOpt++;
    RedoModes++;
    ProcessKeys ();
    RecurseDepth--;
    Cant1LineOpt++;
    RedoModes++;
    CurExec = oldp;
    InputFD = oldf;
#ifdef subprograms
    *inp = oldspi;
    ConnectInput(oldin);
    ConnectOutput(oldout);
#endif
    return 0;
}

/* Return MLisp value nonzero if (a) input pending or (b) we can't tell */

static
KeysPending () {
    ReleaseExpr (MLvalue);
    MLvalue -> exp_type = IsInteger;
#ifdef IPEND
    if (!InputPending)
	IPEND(InputPending);
    MLvalue -> exp_int = InputPending;
#else
    MLvalue -> exp_int = -1;
#endif
    return 0;
}

InitKey () {
    PushedBack = -1;
    MetaPushBack = -1;
#ifdef CatchSig
    signal (SIGINT, IllegalOperation);
    signal (SIGTERM, IllegalOperation);
#endif
#ifdef DumpableEmacs
    if (!Once) {
	FluidStatic (&MetaFlag, sizeof MetaFlag);
	FluidStatic (&ExecutingKeyboardMacro, sizeof ExecutingKeyboardMacro);
#else
    {
#endif
	setkey (CtlXmap, ('e'), ExecuteKeyboardMacro, "execute-keyboard-macro");
	setkey (CtlXmap, ('('), StartRemembering, "start-remembering");
	setkey (CtlXmap, (')'), StopRemembering, "stop-remembering");
	DefIntVar ("checkpoint-frequency", &CheckpointFrequency);
	CheckpointFrequency = 300;
	DefIntVar ("echo-keystrokes", &EchoKeys);
	EchoKeys = -1;
	DefIntVar ("echo-argument", &EchoArg);
	EchoArg = -1;
	defproc (PushBackCharacter, "push-back-character");
	defproc (RecursiveEdit, "recursive-edit");
	defproc (KeysPending, "pending-input");
	DefIntVar ("this-command", &ThisCommand);
	RecurseDepth = 0;
    }
}

lispfuncs.c     508579284   1094  1000  100644  13161     `
/* lisp functions to handle environment enquiries */

/*		Copyright (c) 1981,1980 James Gosling		*/

#include "buffer.h"
#include "window.h"
#include "keyboard.h"
#include "mlisp.h"
#include "macros.h"
#include "pwd.h"
#include "config.h"
/* ACT */
#	include <sys/time.h>
#	include <sys/types.h>
#	include <sys/timeb.h>

static struct passwd *pw;	/* password entry for the current user */
static char LoginId[12];	/* login ID of current user */
static char FullName[50];	/* full name of current user */
/* ACT */
	static struct timeb sys_timeb;
static char ConvertedSystemName[40];

extern baud_rate, NumReplaced;
IntFunc (BaudRate, baud_rate);
IntFunc (WindowHeight, wn_cur->w_height - (wn_cur->w_next ? 1 : 0));
MarkFunc (DotVal,dot)
MarkFunc (MarkVal, bf_cur->b_mark ? ToMark (bf_cur -> b_mark) :
		(error("No mark set in this buffer!"), -1))
IntFunc (BufSize,NumCharacters+1-FirstCharacter)
IntFunc (CurColFunc,CalcCol())
IntFunc (ThisIndent,CurIndent())
IntFunc (bobp, dot<=FirstCharacter)
IntFunc (eobp, dot>NumCharacters)
IntFunc (bolp, dot<=FirstCharacter || CharAt(dot-1)=='\n')
IntFunc (eolp, dot>NumCharacters || CharAt(dot)=='\n')
IntFunc (FollChar, dot>NumCharacters ? 0 : CharAt(dot))
IntFunc (PrevChar, dot<=FirstCharacter ? 0 : CharAt(dot-1))
IntFunc (FetchLastKeyStruck, LastKeyStruck)
IntFunc (FetchPreviousCommand, PreviousCommand)
IntFunc (RecursionDepth, RecurseDepth)
IntFunc (Nargs, ExecutionRoot.CurExec ? ExecutionRoot.CurExec->p_nargs : 0)
IntFunc (Interactive, ExecutionRoot.CurExec==0)
/* ACT */
	IntFunc (UsersID, getuid ())
	IntFunc (IsTopWindow, wn_cur->w_prev==0)
	IntFunc (NumberOfReplacements, NumReplaced)
	extern char *MyTtyName;
	StrFunc (ReturnTtyName, MyTtyName)
StrFunc (CurrentBufferName, bf_cur->b_name)
StrFunc (CurrentFileName, bf_cur->b_fname ? bf_cur->b_fname : "")
StrFunc (UsersLoginName, LoginId)
StrFunc (UsersFullName, FullName)
StrFunc (ReturnSystemName, ConvertedSystemName)
extern char version[];
StrFunc (EmacsVersion, version)

static
ExpandFileName () {
    static char buf[MaxPathNameLen];
    register char  *fn = getstr (": expand-file-name ");
    if (abspath (fn, buf) < 0) {
	error ("Can't expand file name: %s", fn);
	return 0;
    }
    MLvalue -> exp_type = IsString;
    MLvalue -> exp_v.v_string = buf;
    MLvalue -> exp_release = 0;
    MLvalue -> exp_int = strlen (buf);
    return 0;
}

static
CurrentTime () {
    long    now = time ( (long *) 0);
    MLvalue -> exp_type = IsString;
    MLvalue -> exp_v.v_string = (char *) ctime (&now);
    MLvalue -> exp_v.v_string[24] = '\0';
    MLvalue -> exp_release = 0;
    MLvalue -> exp_int = 24;
    return 0;
}

/* ACT */
static
CurrentTimezone () {
    static struct timeb ti;
    register struct tm *tm;
    struct tm *localtime ();
    long    now = time ((long *) 0);
    if (!ti.timezone)
	ftime (&ti);
    tm = localtime (&now);
    MLvalue -> exp_type = IsString;
    MLvalue -> exp_v.v_string = (char *)
			timezone (ti.timezone, tm -> tm_isdst);
    MLvalue -> exp_release = 0;
    MLvalue -> exp_int = strlen (MLvalue -> exp_v.v_string);
    return 0;
}

/* (arg i [prompt]) evaluates the i'th argument to the current function
   or prompts if called interactivly */
Arg () {
    register    i = NumericArg (1);
    register struct ProgNode   *p = ExecutionRoot.CurExec;
    struct ExecutionStack   old;
    if (err)
	return 0;
    if (p == 0 || ExecutionRoot.DynParent == 0) {
	if (StringArg (2)) {
	    LastArgUsed = 0;
	    return GetTtySomething ("string");
	}
	return 0;
    }
    if (i > p -> p_nargs || i <= 0) {
	error ("Bad argument index: (arg %d)", i);
	return 0;
    }
    old = ExecutionRoot;
    ExecutionRoot = *ExecutionRoot.DynParent;
    ExecProg (p -> p_args[i - 1]);
    ExecutionRoot = old;
    return 0;
}

static
DotIsVisible () {		/* tries to guess whether or not dot is
				   currently visible on the screen */
    register windowtop = ToMark (wn_cur->w_start);
    MLvalue -> exp_type = IsInteger;
    MLvalue -> exp_int =
	dot>=windowtop &&
	 dot-(dot>NumCharacters) < ScanBf('\n', windowtop, wn_cur->w_height-1);
    return 0;
}

static
Substr () {			/* evaluate (substr str pos n) */
    register    pos = NumericArg (2), n = NumericArg (3);
    register char  *p;
    if (StringArg (1)) {
	if (pos < 0)
	    pos = MLvalue -> exp_int + 1 + pos;
	if (pos <= 0)
	    pos = 1;
	if (n < 0) {
	    n = MLvalue -> exp_int + n;
	    if (n < 0)
		n = 0;
	}
	if (pos + n - 1 > MLvalue -> exp_int) {
	    n = MLvalue -> exp_int + 1 - pos;
	    if (n < 0)
		n = 0;
	}
	p = (char *) malloc (n + 1);
	strcpyn (p, MLvalue -> exp_v.v_string + pos - 1, n);
	p[n] = '\0';
	ReleaseExpr (MLvalue);
	MLvalue -> exp_int = n;
	MLvalue -> exp_release = 1;
	MLvalue -> exp_v.v_string = p;
    }
    return 0;
}

static
ToColCommand () {
    register    n = getnum (": to-col ");
    if (!err)
	ToCol (n);
    return 0;
}

static
CharToString () {
    register    n = getnum (": char-to-string ");
    ReleaseExpr (MLvalue);
    MLvalue -> exp_type = IsString;
    MLvalue -> exp_release = 1;
    MLvalue -> exp_int = 1;
    MLvalue -> exp_v.v_string = (char *) malloc (2);
    MLvalue -> exp_v.v_string[0] = n & 0177;
    MLvalue -> exp_v.v_string[1] = '\0';
    return 0;
}

static
StringToChar () {
    register char  *s = getstr (": string-to-char ");
    ReleaseExpr (MLvalue);
    MLvalue -> exp_type = IsInteger;
    MLvalue -> exp_int = s ? *s : 0;
    return 0;
}

static
InsertCharacter () {
    SelfInsert (getnum (": insert-character "));
    return 0;
}

static
GetTtyString () {		/* get a string from the tty */
    return GetTtySomething ("string");
}

static
GetTtyCommand () {		/* get a command name from the tty */
    return GetTtySomething ("command");
}

static
GetTtyVariable () {		/* get a variable name from the tty */
    return GetTtySomething ("variable");
}

GetTtyBuffer () {		/* get a buffer name from the tty */
    return GetTtySomething ("buffer");
}

/* ACT */
GetExistingFile () {
    char *prompt = savestr (getstr (": get-existing-file (prompt) ")),
	 *GetFileName ();
    register struct ProgNode *OldExec = CurExec;

    CurExec = 0;
    ReleaseExpr (MLvalue);
    MLvalue -> exp_v.v_string = GetFileName (prompt);
    free (prompt);
    CurExec = OldExec;
    if (MLvalue -> exp_v.v_string == 0)
	MLvalue -> exp_type = IsVoid;
    else {
	MLvalue -> exp_type = IsString;
	MLvalue -> exp_release = 0;
	MLvalue -> exp_int = strlen (MLvalue -> exp_v.v_string);
    }
    return 0;
}

/* Helper function for get-tty-string, get-tty-command, and
   get-tty-variable */
static
GetTtySomething (something)
char   *something; {
    char   *prompt1 = getstr (": get-tty-%s (prompt) ", something);
    register    FILE * LInputFD = InputFD;
    register struct ProgNode   *LCurExec = CurExec;
/*  register char  *LMemPtr = MemPtr; */
    register char  *answer;
    if (prompt1) {
	register i;
	char prompt[500];
	strcpyn (prompt, prompt1, sizeof prompt);
	prompt [sizeof prompt - 1] = 0;
	InputFD = stdin;
	CurExec = 0;
/*	MemPtr = 0; */
	ReleaseExpr (MLvalue);
	switch (*something) {
	    case 's': 		/* get-tty-string */
		answer = getstr ("%s", prompt);
		break;
	    case 'b':		/* get-tty-buffer */
		i = getword (BufNames, prompt);
		answer = i < 0 ? 0 : BufNames[i];
		break;
	    case 'c': 		/* get-tty-command */
		i = getword (MacNames, prompt);
		answer = i < 0 ? 0 : MacNames[i];
		break;
	    case 'v': 		/* get-tty-variable */
		i = getword (VarNames, prompt);
		answer = i < 0 ? 0 : VarNames[i];
		break;
	}
	InputFD = LInputFD;
/*	MemPtr = LMemPtr; */
	CurExec = LCurExec;
	if (answer) {
	    MLvalue -> exp_int = strlen (answer);
	    MLvalue -> exp_v.v_string = savestr (answer);
	    MLvalue -> exp_type = IsString;
	    MLvalue -> exp_release = 1;
	}
	else
	    MLvalue -> exp_type = IsVoid;
    }
    return 0;
}

static
GetTtyCharacter () {		/* get a character from the tty */
    register FILE *LInputFD = InputFD;
    register struct ProgNode   *LCurExec = CurExec;
/*  register char  *LMemPtr = MemPtr; */
    InputFD = stdin;
    CurExec = 0;
/*  MemPtr = 0; */
    MLvalue -> exp_int = GetChar ();
    MLvalue -> exp_type = IsInteger;
    InputFD = LInputFD;
/*  MemPtr = LMemPtr; */
    CurExec = LCurExec;
    return 0;
}

Concat () {			/* implements (concat str str str) */
    StringArg (1);
    if (!err && CurExec -> p_nargs > 1) {
	register char  *p = (char *) malloc (100);
	register    space = 100;
	register    size = 0;
	register    i = 1;
	do {
	    if (size + MLvalue -> exp_int >= space)
		p = (char *) realloc (p, space += MLvalue -> exp_int + 100);
	    strcpyn (p + size, MLvalue -> exp_v.v_string, MLvalue -> exp_int);
	    size += MLvalue -> exp_int;
	    i++;
	} while (i <= CurExec -> p_nargs && StringArg (i));
	ReleaseExpr (MLvalue);
	MLvalue -> exp_type = IsString;
	MLvalue -> exp_int = size;
	MLvalue -> exp_release = 1;
	MLvalue -> exp_v.v_string = p;
	p[size] = '\0';
    }
    return 0;
}

static
RegionToString () {
    register    left,
                right;
    if (bf_cur -> b_mark == 0) {
	error ("Mark not set");
	return 0;
    }
    left = ToMark (bf_cur -> b_mark);
    if (left <= dot)
	right = dot;
    else {
	right = left;
	left = dot;
    }
    if (left <= bf_s1 && right > bf_s1)
	GapTo (left);
    MLvalue -> exp_v.v_string =
	(char *) malloc ((MLvalue -> exp_int = right - left) + 1);
    strcpyn (MLvalue -> exp_v.v_string, &CharAt (left), MLvalue -> exp_int);
    MLvalue -> exp_v.v_string[MLvalue -> exp_int] = '\0';
    MLvalue -> exp_release = 1;
    MLvalue -> exp_type = IsString;
    return 0;
}

Length () {
    if (StringArg (1)) {
	ReleaseExpr (MLvalue);
	MLvalue -> exp_type = IsInteger;
    }
    return 0;
}

static
GotoCharacter () {
    register    n = getnum (": goto-character ");
    if (!err) {
	if (n < 1)
	    n = 1;
	if (n > NumCharacters)
	    n = NumCharacters + 1;
	SetDot (n);
    }
    return 0;
}

NoValue () {			/* (novalue) acts like a non-existant value,
				   useful for returning from MLisp
				   functions. */
    return 0;
}

static  Getenv () {
    char   *vname = getnbstr (": getenv ");
    if (vname == 0)
	return 0;
    if ((MLvalue -> exp_v.v_string = (char *) getenv (vname)) == 0)
	error ("There is no environment variable named %s", vname);
    MLvalue -> exp_type = IsString;
    MLvalue -> exp_release = 0;
    MLvalue -> exp_int = strlen (MLvalue -> exp_v.v_string);
    return 0;
}

InitFunc () {
#ifdef DumpableEmacs
    if (!Once)
#endif
    {
	defproc (ExpandFileName, "expand-file-name");
	defproc (NoValue, "novalue");
	defproc (GotoCharacter, "goto-character");
	defproc (ToColCommand, "to-col");
	defproc (CharToString, "char-to-string");
	defproc (StringToChar, "string-to-char");
	defproc (RegionToString, "region-to-string");
	defproc (BaudRate, "baud-rate");
	defproc (WindowHeight, "window-height");
	defproc (DotIsVisible, "dot-is-visible");
	defproc (Length, "length");
	defproc (Substr, "substr");
	defproc (Concat, "concat");
	defproc (GetTtyString, "get-tty-string");
	defproc (GetTtyCommand, "get-tty-command");
	defproc (GetTtyVariable, "get-tty-variable");
	defproc (GetTtyBuffer, "get-tty-buffer");
	defproc (DotVal, "dot");
	defproc (MarkVal, "mark");
	defproc (BufSize, "buffer-size");
	defproc (CurColFunc, "current-column");
	defproc (ThisIndent, "current-indent");
	defproc (bobp, "bobp");
	defproc (eobp, "eobp");
	defproc (bolp, "bolp");
	defproc (eolp, "eolp");
	defproc (FollChar, "following-char");
	defproc (PrevChar, "preceding-char");
	defproc (FetchLastKeyStruck, "last-key-struck");
	defproc (FetchPreviousCommand, "previous-command");
	defproc (RecursionDepth, "recursion-depth");
	defproc (InsertCharacter, "insert-character");
	defproc (GetTtyCharacter, "get-tty-character");
	defproc (CurrentBufferName, "current-buffer-name");
	defproc (CurrentFileName, "current-file-name");
	defproc (UsersLoginName, "users-login-name");
	defproc (UsersFullName, "users-full-name");
	defproc (CurrentTime, "current-time");
	defproc (CurrentTimezone, "current-timezone");
	defproc (Getenv, "getenv");
	defproc (Arg, "arg");
	defproc (Nargs, "nargs");
	defproc (Interactive, "interactive");
	defproc (ReturnSystemName, "system-name");
	defproc (EmacsVersion, "emacs-version");
	{
	    register char  *p = SystemName;
	    if (p == 0 || *p == 0)
		p = "Bogus System Name";
	    strcpyn (ConvertedSystemName, p, sizeof ConvertedSystemName);
	    p = ConvertedSystemName;
	    while (*p) {
		if (*p < ' ')
		    *p = 0;
		else
		    if (*p == ' ')
			*p = '-';
		p++;
	    }
	}
	/* ACT */
	defproc (UsersID, "users-id");
	defproc (ReturnTtyName, "tty-name");
	defproc (IsTopWindow, "is-top-window");
	defproc (GetExistingFile, "get-existing-file");
	defproc (NumberOfReplacements, "number-of-replacements");
	/* End UofM ACT */
    }

#ifdef apm
    strcpyn (LoginId, getenv("HOME") , sizeof LoginId);
    strcpyn (FullName, LoginId, sizeof FullName);
#else
    pw = (struct passwd *) getpwuid (getuid ());
    strcpyn (LoginId, pw->pw_name, sizeof LoginId);
    strcpyn (FullName, MailOriginator, sizeof FullName);
#endif
    /* Set up LoadSearchPath */
    if ((LoadSearchPath = (char *) getenv ("EPATH")) == 0)
	LoadSearchPath = PATH_LOADSEARCH;
}

macros.c        508005724   1094  1000  100644  6495      `
/* Stuff to do with the manipulation of macros.
   For silly historical reasons, several routines that should be here
   are actually in options.c (eg. the command level callers). */

/*		Copyright (c) 1981,1980 James Gosling		*/

/* Modifications per Chris Torek, forwarded Feb 1984 (#264) */

#include "keyboard.h"
#include "macros.h"
#include "buffer.h"
#include <ctype.h>

/* Find the index of the named macro or command; -(index of where the
   name should have been if it isn't found)-1. */
FindMac (s)
char   *s; {
    register    hi,
                lo,
                mid;
    register char *s1, *s2;
    lo = 0;
    hi = NMacs - 1;
    while (lo <= hi) {
	mid = (lo + hi) >> 1;
	s1 = s;
	s2 = MacNames[mid];
	while (*s1 == *s2++)
	  if(*s1++==0) return mid;
	if (*s1 < *--s2)
	    hi = mid - 1;
	else
	    lo = mid + 1;
    }
    return - lo - 1;
}

EditMacro () {
    register    i = getword (MacNames, ": edit-macro ");
    register struct BoundName  *p;
    if (i < 0)
	return 0;
    p = MacBodies[i];
    if (p -> b_binding != MacroBound)
	error ("%s is a procedure, not a macro!", p -> b_name);
    else {
	SetBfn ("Macro edit");
	EraseBf (bf_cur);
	if(bf_cur->b_fname) free(bf_cur->b_fname);
	bf_cur->b_fname = savestr (p->b_name);
	bf_cur->b_kind = MacroBuffer;
	WindowOn (bf_cur);
	InsStr (p -> b_bound.b_body);
	bf_modified = 0;
	BeginningOfFile ();
    }
    return 0;
}

DefineBufferMacro () {
    if (bf_cur -> b_kind != MacroBuffer || bf_cur -> b_name == 0)
	error ("This buffer doesn't contain a named macro.");
    else {
	GapTo (bf_s1 + bf_s2 + 1);	/* ignoring our abstract data type
					   hiding!! */
	*(bf_p1 + bf_s1 + 1) = 0;
	DefMac (bf_cur -> b_fname, bf_p1 + 1, 0);
	bf_modified = 0;
    }
}

/* define the named macro to have the given body (or mlisp proc)
   This procedure occupies a lot of time when loading mlisp packages
   and/or .emacs_pro's, so it's been tweaked. */
DefMac (s, body, IsMLisp)
union {
    struct keymap *b_keymap;
    struct ProgNode * b_ProgNode;
    char  *b_string;
} body;
char *s;
{
    register int    i;
    register struct BoundName  *p;
    if ((i = FindMac (s)) < 0) {
	register struct BoundName **bp;
        register char **np;
	register struct BoundName **be;
	if (NMacs >= maxmacs) {
	    error ("Too many macro definitions.");
	    return;
	}
	np = &MacNames[NMacs];
	bp = &MacBodies[NMacs++];
	be = &MacBodies[-i - 1];
	np[1] = 0;		/* sneaky! */
	while (bp > be) {
	    np[0] = np[-1];
	    bp[0] = bp[-1];
	    --np, --bp;
	}
	p = *bp = (struct BoundName  *) malloc (sizeof (struct BoundName));
	p -> b_name = *np = savestr (s);
	p -> b_active = 0;
    }
    else {
	if ((p = MacBodies[i]) -> b_binding == ProcBound) {
	    error ("%s is already bound to a wired procedure!", s);
	    return;
	}
	if (IsMLisp == -1	/* Its an autoload definition of an already
				   defined function, ignore it. */
		    && (p -> b_binding != MLispBound || p -> b_bound.b_prog)
		    && p -> b_binding != AutoLoadBound)
	    return;
	if (p -> b_binding == KeyBound) {
	    register struct buffer *b;
	    for (b = buffers; b; b = b -> b_next)
		if (b -> b_mode.md_keys == p -> b_bound.b_keymap)
		    b -> b_mode.md_keys = 0;
	    if (CurrentGlobalMap == p -> b_bound.b_keymap)
		CurrentGlobalMap == &GlobalMap;
	    if (bf_mode.md_keys == p -> b_bound.b_keymap)
		bf_mode.md_keys == 0;
	    NextLocalKeymap = NextGlobalKeymap = 0;
	    free (p -> b_bound.b_keymap);
	}
	else if (p -> b_binding == AutoLoadBound
			|| p -> b_binding == MacroBound)
	    free (p -> b_bound.b_body);
    }
    if (IsMLisp == -1) {
	p -> b_binding = AutoLoadBound;
	p -> b_bound.b_body = savestr (body.b_string);
    }
    else if (IsMLisp == -2) {
	p -> b_binding = KeyBound;
	p -> b_bound.b_keymap = body.b_keymap;
    }
    else if (IsMLisp) {
	p -> b_binding = MLispBound;
	p -> b_bound.b_prog = body.b_ProgNode;	
    }
    else {
	p -> b_binding = MacroBound;
	p -> b_bound.b_body = savestr (body.b_string);
    }
}

static
ScanMap (map)
register struct keymap *map; {
    register struct BoundName *p;
    register c;
    for (c = 0; c < 0200; c++)
	if (p = map -> k_binding[c]) {
	    int     lo = 0,
	            hi = NMacs - 1;
	    register struct BoundName **m;
	    while (lo <= hi) {
		register mid = (lo + hi) >> 1;
		m = &MacBodies[mid];
		if (*m == p)
		    goto SkipIt;
		if (*m > p)
		    hi = mid - 1;
		else
		    lo = mid + 1;
	    }
	    m = &MacBodies[lo];
	    {
		register struct BoundName **j = NewNames++;
		while (j > m) {
		    j[0] = j[-1];
		    j--;
		}
	    }
	    *m = p;
	    NMacs++;
    SkipIt: 
	    if (islower (c))
		map -> k_binding[toupper (c)] = p;
	}
}

static
QSortN (l, h)
struct BoundName **l;
register struct BoundName **h;
{
    register struct BoundName **i,
			      **j;
    register char *s1,
		  *s2;
    if ((i = l) >= h)
	return;
    j = h;
partition: 
 /* while (strcmp ((*i) -> b_name, (*h) -> b_name) < 0) i++; */
    for (;;) {
	s1 = (*i) -> b_name;
	s2 = (*h) -> b_name;
	while (*s1 == *s2++)
	    if (*s1++ == 0)
		goto out1;
	if (*s1 > *--s2)
	    break;
	i++;
    }
out1:
 /* while (--j > i && strcmp ((*j) -> b_name, (*h) -> b_name) > 0); */
    while (--j > i) {
	s1 = (*j) -> b_name;
	s2 = (*h) -> b_name;
	while (*s1 == *s2++)
	    if (*s1++ == 0)
		goto out2;
	if (*s1 < *--s2)
	    break;
    }
out2:
    if (i < j) {
	register struct BoundName *t;
	t = *i, *i = *j, *j = t;
	goto partition;
    }
    if (i < h) {
	register struct BoundName *t;
	t = *i, *i = *h, *h = t;
	QSortN (i + 1, h);
    }
    QSortN (l, i - 1);
}

static
QSortA (l, h)
struct BoundName **l;
register struct BoundName **h;
{
    register struct BoundName **i,
			      **j;
    if ((i = l) >= h)
	return;
    j = h;
partition: 
    while (*i < *h)
	i++;
    while (--j > i && *j > *h);
    if (i < j) {
	register struct BoundName *t;
	t = *i, *i = *j, *j = t;
	goto partition;
    }
    if (i < h) {
	register struct BoundName *t;
	t = *i, *i = *h, *h = t;
	QSortA (i + 1, h);
    }
    QSortA (l, i - 1);
}

InitMacros () {
    register int    i;
    register struct BoundName *p;
    defproc (EditMacro, "edit-macro");
    defproc (DefineBufferMacro, "define-buffer-macro");
    NMacs = NewNames - MacBodies;
    QSortA (MacBodies, &MacBodies[NMacs - 1]);
    ScanMap (&GlobalMap);
    ScanMap (&ESCmap);
    ScanMap (&CtlXmap);
    QSortN (MacBodies, &MacBodies[NMacs - 1]);
    for(i=0; p = MacBodies[i]; i++)
	MacNames[i] = p->b_name;
    MacNames[i] = "nothing";
    MacBodies[i++] = 0;
    NMacs = i;
}

metacoms.c      508005726   1094  1000  100644  4277      `
/* Routines to handle most of the "Meta" commands */

/*		Copyright (c) 1981,1980 James Gosling		*/

/* Modified DJH 7-Dec-80	Add end-of-window = Meta-Period	*/

#include "macros.h"
#include "window.h"
#include "buffer.h"
#include "keyboard.h"
#include "syntax.h"

DeleteRegionToBuffer () {
    register char *fn = getnbstr("Move region to buffer: ");
    if(fn==0) return 0;
    if (bf_cur -> b_mark == 0) {
	error ("Mark not set");
	return 0;
    }
    DelToBuf (ToMark (bf_cur -> b_mark) - dot, 0, 1, fn);
    return 0;
}

YankBuffer () {
    register char *fn = getnbstr("Insert contents of buffer: ");
    if(fn==0) return 0;
    InsertBuffer (fn);
    return 0;
}

BeginningOfFile () {		/* $< */
    SetDot (FirstCharacter);
    return 0;
}

EndOfFile () {			/* $> */
    SetDot (NumCharacters + 1);
    return 0;
}

/* DJH -- go to end of window.	*/
EndOfWindow () {		/* $. */
    SetDot (ScanBf ('\n', ToMark (wn_cur -> w_start),
		wn_cur -> w_height - 2));
    EndOfLine ();
    return 0;
}

BeginningOfWindow () {		/* $, */
    SetDot (ToMark (wn_cur -> w_start));
    return 0;
}

/* skip over (non) punctuation characters; punct=1 => skip punctuation,
   0 => skip non-punctuation; incr=1 => forward, -1 => backward.
   returns number of characters skipped (signed) */
SkipOver (punct, incr, dot)
register    incr,
	    dot; {
    register    n = 0;
    if (incr < 0)
	dot--;
    while ((bf_mode.md_syntax->s_table[CharAt (dot)].s_kind != WordChar)
		== punct
	    && dot >= FirstCharacter && dot <= NumCharacters) {
	dot += incr;
	n += incr;
    }
    return n;
}

WordOperation (direction, delete) {
    register    incr,
                n;
    do {
	incr = direction;
	n = SkipOver (1, incr, dot);
	if ((n += SkipOver (0, incr, dot + n)) == 0)
	    return 0;
	if (direction < 0 && delete)
	    DelBack (dot, -n), DotLeft (-n);
	else
	    if (delete)
		DelFrwd (dot, n);
	    else
		DotRight (n);
    } while (--arg > 0 && !err);
    return 0;
}

ForwardWord() {
    WordOperation (1, 0);
}

BackwardWord() {
    WordOperation (-1, 0);
}

DeleteNextWord() {
    WordOperation (1, 1);
}

DeletePreviousWord() {
    WordOperation (-1, 1);
}

static struct BoundName *AproposTarget;
static char *AproposPointer;

AproposHelper (b, keys, len, range)
register struct BoundName *b;
char *keys;
{
    register    k;
    char   *s;
    if (b != AproposTarget) return;
    s = KeyToStr (keys, len);
    k = strlen (s);
    strcpy (AproposPointer, ", ");
    strcpy (AproposPointer + 2, s);
    AproposPointer += k + 2;
    if (range > 1) {
	keys[len - 1] += range-1;
	strcpy (AproposPointer, "..");
	s = KeyToStr (keys, len);
	k = strlen (s);
	strcpy (AproposPointer + 2, s);
	AproposPointer += k + 2;
	keys[len - 1] -= range-1;
    }
    *AproposPointer = 0;
}

Apropos () {			/* $? */
    register char  *keyword = getnbstr (": apropos keyword: ");
    register struct buffer *old = bf_cur;
    register    i;
    char    buf[4000];
    if (keyword == 0)
	return 0;
    SetBfn ("Help");
    WindowOn (bf_cur);
    WidenRegion ();
    EraseBf (bf_cur);
    for (i = 0; MacNames[i]; i++)
	if (sindex (MacNames[i], keyword)) {
	    char    keys[3000];
	    keys[0] = 0;
	    AproposPointer = keys;
	    AproposTarget = MacBodies[i];
	    ScanMap (CurrentGlobalMap, AproposHelper, 1);
	    ScanMap (old -> b_mode.md_keys, AproposHelper, 1);
	    InsStr (sprintfl (buf, sizeof buf, keys[0] ? "%-30s(%s)\n" : "%s\n",
			MacNames[i], keys + 2));
	}
    SetDot (1);
    bf_cur -> b_mode.md_NeedsCheckpointing = 0;
    bf_modified = 0;
    SetBfp (old);
    WindowOn (bf_cur);
    return 0;
}

InitMeta () {
	setkey (ESCmap, (Ctl ('W')), DeleteRegionToBuffer, "delete-region-to-buffer");
	setkey (ESCmap, (Ctl ('Y')), YankBuffer, "yank-buffer");
	setkey (ESCmap, ('<'), BeginningOfFile, "beginning-of-file");
	setkey (ESCmap, ('>'), EndOfFile, "end-of-file");
	setkey (ESCmap, ('.'), EndOfWindow, "end-of-window");	/* DJH */
	setkey (ESCmap, (','), BeginningOfWindow, "beginning-of-window");
	setkey (ESCmap, ('?'), Apropos, "apropos");
	setkey (ESCmap, ('f'), ForwardWord, "forward-word");
	setkey (ESCmap, ('b'), BackwardWord, "backward-word");
	setkey (ESCmap, ('h'), DeletePreviousWord, "delete-previous-word");
	setkey (ESCmap, ('d'), DeleteNextWord, "delete-next-word");
}

minibuf.c       508005726   1094  1000  100644  12824     `
/* Routines to handle the minibuffer (the one-line display at the
   bottom of the screen) */

/*		Copyright (c) 1981,1980 James Gosling		*/

/* Modified DJH 7-Dec-80	Added InitMiniBuf
				Make help on getword errors optional
 */
#include "buffer.h"
#include "window.h"
#include "keyboard.h"
#include "mlisp.h"
#include <ctype.h>

#define BufferSize 200
static char buf[BufferSize];
static StackTraceOnError;	/* if true, whenever an error is encountered
				   a stack trace will be dumped to the stack
				   trace buffer */
int RemoveHelpWindow;		/* if true, then the help window will be
				   removed on exit of any command completion
				   routines.  13-Jan-83 BNI */
char last_message[132];		/* copy of last message to screen */
extern PopUpWindows;


/* sprintrmt(arg) effecttivly does an sprintf(buf,arg[0],arg[1],...); */
sprintrmt(buf, arg)
char *buf;
register char **arg; {
	struct _iobuf _strbuf;

	_strbuf._flag = _IOSTRG;
	_strbuf._ptr = buf;
	_strbuf._cnt = BufferSize;
	_doprnt(*arg, arg+1, &_strbuf);
	putc('\0', &_strbuf);
}

/* This is the same as the standard sprintf (buf, ...) except that it
   guarantees to return buf */
/* VARARGS */
char *sprintf (buf, fmt, args)
char *buf, *fmt; {
	struct _iobuf _strbuf;

	_strbuf._flag = _IOSTRG;
	_strbuf._ptr = buf;
	_strbuf._cnt = 10000;
	_doprnt(fmt, &args, &_strbuf);
	putc('\0', &_strbuf);
	return buf;
}

/* This is the same as sprintf (buf, ...) except that it guards against
   buffer overflow */
/* VARARGS */
char *sprintfl (buf, len, fmt, args)
char *buf, *fmt; {
	struct _iobuf _strbuf;

	_strbuf._flag = _IOSTRG;
	_strbuf._ptr = buf;
	_strbuf._cnt = len-1;
	_doprnt(fmt, &args, &_strbuf);
	putc('\0', &_strbuf);
	buf[len-1] = 0;
	return buf;
}

/* dump an error message; called like printf */
/* VARARGS 1 */
error (m) {
    NextLocalKeymap = 0;
    NextGlobalKeymap = 0;
    if(err && MiniBuf) return;	/* the first error message probably makes the
				   most sense, so we suppress subsequent
				   ones. */
    err++;
    sprintrmt (buf, &m);
    strncpy (last_message, buf, sizeof last_message);
    MiniBuf = buf;
    DumpMiniBuf++;
    if (StackTraceOnError && CurExec) DumpStackTrace ();
}

/* dump an informative message to the minibuf */
/* VARARGS 1 */
message (m) {
    if(!interactive || err && MiniBuf) return;
    sprintrmt (buf, &m);
    strncpy (last_message, buf, sizeof last_message);
    MiniBuf = buf;
    DumpMiniBuf++;
    Cant1LineOpt++;
}

/* read a number from the terminal with prompt string s */
/* VARARGS 1 */
getnum (s) char *s; {
    register char  *p,
                   *answer;
    if (CurExec) {		/* we are being called from an
				   MLisp-called function.  Instead of
				   prompting for a string we evaluate it
				   from the arg list */
	register larg = arg;
	register enum ArgStates largstate = ArgState;
	register n;
	ArgState = NoArg;
	if (++LastArgUsed >= CurExec -> p_nargs) {
	    error ("Too few arguments given to %s",
			CurExec -> p_proc -> b_name);
	    return 0;
	}
	n = NumericArg (LastArgUsed+1);
	arg = larg;
	ArgState = largstate;
	return n;
    }
    return StrToInt (BrGetstr (1, "", &s));
}

StrToInt (answer)
char *answer; {
    register char *p = answer;
    register n = 0, neg = 0;
    if (p == 0)
	return 0;
    while(isspace(*p)) p++;
    if(*p>='A'){
	register len = strlen(answer);
	if(strcmpn(answer,"on",len)==0
		|| strcmpn(answer,"true",len)==0) return 1;
	if(strcmpn(answer,"off",len)==0
		|| strcmpn(answer,"false",len)==0) return 0;
    }
    while (*p) {
	if (isdigit (*p))
	    n = n * 10 + *p - '0';
	else
	    if (*p == '-')
		neg = !neg;
	    else
		if (!isspace (*p) && *p != '+') {
		    error ("Malformed integer: \"%s\"", answer);
		    return 0;
		}
	p++;
    }
    return neg ? -n : n;
}

/* Read a string from the terminal with prompt string s */
/* VARARGS 1 */
char   *getstr (s) {
    return BrGetstr (0, "", &s);
}

/* Read a string from the terminal with prompt string s, whitespace
   will terminate it. */
/* VARARGS 1 */
char   *getnbstr (s) {
    return BrGetstr (1, "", &s);
}

int AutoHelp;			/* true iff ambiguous or misspelled words
				   should create a help window (DJH) */

/* Read a word from the terminal using prompt string s and
   restricting the word to be one of those in the given table.
   Returns the index of the word in the table.
   Returns -1 on failure.
   eg.	static char **words = { "command1", "command2", 0 };
	switch(getword(words,"prompt")){ */
/* VARARGS 2 */
getword(table, s)
register char **table;
char *s; {
    register char  *word;
    register int    p;
    int             bestp = -1,
                    nfound;
    register char *s1, *s2;
    int ctr;
    struct window  *killee = 0;
    struct buffer  *old = bf_cur;
    int     len;
    char    prefix[200];
    int     side;
    int	    oldpop;		/* old value of pop-up-windows */

    oldpop = PopUpWindows;
    if (RemoveHelpWindow) PopUpWindows = 0;
    prefix[0] = '\0';
    while (word = BrGetstr (1, prefix, &s)) {
	len = strlen (word);
	prefix[0] = '\0';
	nfound = 0;
	if (word[len - 1] != '?')
	    for (p = 0; s1 =table[p]; p++) {
		s2 = word;
		for (ctr = len; *s1++==*s2++ && --ctr>0;);
		if (ctr <= 0) {
		    nfound++;
		    if (nfound == 1)
			strcpy (prefix, table[p]);
		    else {
			register char  *pfx = prefix,
			               *w = table[p];
			while (*pfx++ == *w++);
			*--pfx = '\0';
		    }
		    bestp = p;
		    if (table[p][len] == 0) {/* exact match */
			nfound = 1;
			break;
		    }
		}
	    }
	if (nfound == 1)
	    break;
	bestp = -1;
	if (nfound > 1 && strcmp (prefix, word) != 0)
	    continue;
	if (!interactive){
	    bestp = -1;
	    error ("\"%s\" %s", word,
		nfound	? "is ambiguous."
			: "doesn't make any sense to me.");
	    break;
	}
	if (AutoHelp == 0 && (len <= 0 || word[len - 1] != '?')) {
	    register int    maxlegal = 0;
	    Ding ();		/* DJH -- Don't pop up help window */
	    strcpy (prefix, word);
	    if (nfound == 0) {
		for (p = 0; table[p]; p++)
		    while (strcmpn (table[p], word, maxlegal + 1) == 0)
			maxlegal++;
		prefix[maxlegal] = 0;
	    }
	    continue;
	}
	SetBfn ("Help");
	WindowOn (bf_cur);
	EraseBf (bf_cur);
	{
	    register char  *msg;
	    if (len > 0 && word[len - 1] == '?') {
		len--;
		strcpy (prefix, word);
		prefix[len] = '\0';
		msg = "Choose one of the following:\n";
	    }
	    else
		if (nfound > 1)
		    msg = "Ambiguous, choose one of the following:\n";
		else {
		    len = 0;
		    msg = "Rubbish!  Please use one of the following words:\n";
		};
	    InsStr (msg);
	}
	killee = wn_cur;
	side = 0;
	for (p = 0; table[p]; p++)
	    if (len <= 0 || strcmpn (table[p], word, len) == 0) {
		char    buf[100];
		sprintfl (buf, sizeof buf, (side == 2 ? ((side = 0), "%s\n")
			    : (side++, "%-25s")),
			table[p]);
		InsStr (buf);
	    }
	BeginningOfFile ();
	bf_cur -> b_mode.md_NeedsCheckpointing = 0;
	bf_modified = 0;
    }
    if (killee) {
/*	DelWin (killee);	*/
	WindowOn (old);
    }
    PopUpWindows = oldpop;
    return bestp;
}

/* read a string from the terminal with prompt string s.
   Whitespace will break iff breaksp is true.
   The string "prefix" behaves as though the user had typed that first. */
char   *BrGetstr (breaksp, prefix, s)
char   *prefix,
       ** s;
{
    register    larg = arg;
    register    enum ArgStates largstate = ArgState;
    ArgState = NoArg;
    if (CurExec) {		/* we are being called from an
				   MLisp-called function.  Instead of
				   prompting for a string we evaluate it
				   from the arg list */
	if (++LastArgUsed >= CurExec -> p_nargs) {
	    error ("Too few arguments given to %s",
		    CurExec -> p_proc -> b_name);
	    return 0;
	}
	if (!StringArg (LastArgUsed + 1) || MLvalue -> exp_type != IsString) {
	    error ("%s expected %s to return a value.",
		    CurExec -> p_proc -> b_name,
		    CurExec -> p_args[LastArgUsed] -> p_proc -> b_name);
	    return 0;
	}
	arg = larg;
	ArgState = largstate;
	if (err)
	    return 0;
	if (MLvalue -> exp_v.v_string[MLvalue -> exp_int]) {
	    static char holdit[200];
	/* sigh...  yet another hideous atrocity! */
	    register    len = MLvalue -> exp_int >= sizeof holdit
	    ?           (sizeof holdit) - 1 : MLvalue -> exp_int;
	    strcpyn (holdit, MLvalue -> exp_v.v_string, len);
	    holdit[len] = 0;
	    return holdit;
	}
	else
	    return MLvalue -> exp_v.v_string;
    }
    {
	register struct marker *olddot = NewMark ();
	register char  *result = 0;
	struct keymap  *outermap;
	char   *OuterReset = ResetMiniBuf;
	char    lbuf[BufferSize];
	char    outer[BufferSize];
	int     OuterLen,
	        OuterDot;
	int     WindowNum = -1;
	if (interactive)
	    sprintrmt (lbuf, s);
	if (interactive) {
	    DumpMiniBuf++;
	    ResetMiniBuf = MiniBuf = lbuf;
	}
	SetMark (olddot, bf_cur, dot);
	{
	    register struct window *w = windows;
	    register int    i = 0;
	    while (w -> w_next) {
		if (w == wn_cur)
		    WindowNum = i;
		i++;
		w = w -> w_next;
	    }
	    if (WindowNum < 0)
	    	WindowNum = i;
	    SetWin (w);
	}
	outermap = bf_mode.md_keys;
	bf_mode.md_keys = bf_cur -> b_mode.md_keys =
	    breaksp ? &MinibufLocalNSMap : &MinibufLocalMap;
	NextGlobalKeymap = NextLocalKeymap = 0;
	OuterLen = bf_s1 + bf_s2;
	if (OuterLen > BufferSize)
	    OuterLen = BufferSize;
	OuterDot = dot;
	for (dot = 1; dot <= OuterLen; dot++)
	    outer[dot - 1] = CharAt (dot);
	EraseBf (bf_cur);
	InsStr (prefix);
	MinibufDepth++;
	RecursiveEdit ();
	MinibufDepth--;
	arg = larg;
	ArgState = largstate;
	SetBfp (minibuf);
	bf_mode.md_keys = bf_cur -> b_mode.md_keys = outermap;
	InsertAt (bf_s1 + bf_s2 + 1, 0);
	SetDot (1);
	if (OuterLen)
	    InsCStr (outer, OuterLen);
	SetDot (OuterDot);
	result = err ? 0 : &CharAt (OuterLen + 1);
	if (ResetMiniBuf = OuterReset)
	    MiniBuf = ResetMiniBuf;
	else
	    if (MiniBuf == lbuf)
		MiniBuf = "";
	DelBack (bf_s1 + bf_s2 + 1, bf_s1 + bf_s2 - OuterLen);
	{
	    register struct window *w = windows;
	    while (WindowNum && w -> w_next) {
		WindowNum--;
		w = w -> w_next;
	    }
	    if (WindowNum == 0 && w) {
		SetWin (w);
		dot = ToMark (olddot);
	    }
	    else
		WindowOn (bf_cur);
	}
	dot = ToMark (olddot);
	DestMark (olddot);
	return result;
    }
}

/* Get the name of a key.  Alas, you can't type a control-G,
   since that aborts the key name read.  Returns -1 if aborted. */
/* VARARGS 2 */
char   *getkey (map, prompt)
register struct keymap *map;
char *prompt;
{
    register    c;
    register char  *p,
                   *keys;
    register    nkeys;
    static char FakeIt[30];
    static char lbuf[BufferSize];
    if (CurExec) {
	register larg = arg;
	register enum ArgStates largstate = ArgState;
	ArgState = NoArg;
	EvalArg (++LastArgUsed + 1);
	arg = larg;
	ArgState = largstate;
	if (err)
	    return 0;
	if (MLvalue -> exp_type == IsString)
	    return MLvalue -> exp_v.v_string;
	if (MLvalue -> exp_int > 0177) {
	    FakeIt[0] = MLvalue -> exp_int >= 0400 ? '\030' : '\033';
	    FakeIt[1] = MLvalue -> exp_int & 0177;
	    MLvalue -> exp_int = 2;
	}
	else {
	    FakeIt[0] = MLvalue -> exp_int;
	    MLvalue -> exp_int = 1;
	}
	MLvalue -> exp_type = IsString;
	MLvalue -> exp_release = 0;
	MLvalue -> exp_v.v_string = FakeIt;
	return FakeIt;
    }
    if (interactive) {
	sprintrmt (lbuf, &prompt);
	p = lbuf + strlen (lbuf);
    }
    else
	p = lbuf;
    keys = FakeIt;
    nkeys = 0;
    do {
	*p = 0;
	if (interactive)
	    InMiniBuf++, MiniBuf = lbuf, DumpMiniBuf++;
	if ((c = GetChar ()) == Ctl ('G')) {
	    error ("Aborted.");
	    InMiniBuf = 0;
	    return 0;
	}
	if (++nkeys >= sizeof FakeIt) {
	    error ("key sequence too long");
	    return 0;
	}
	*keys++ = c;
	if (map && map -> k_binding[c]
		&& map -> k_binding[c] -> b_binding == KeyBound)
	    map = map -> k_binding[c] -> b_bound.b_keymap;
	else
	    map = 0;
	if (c == 033) {
	    *p++ = 'E';
	    *p++ = 'S';
	    *p++ = 'C';
	}
	else
	    if (c < 040) {
		*p++ = '^';
		*p++ = (c & 037) + 0100;
	    }
	    else
		*p++ = c;
	if (map)
	    *p++ = '-';
    } while (map);
    *p++ = 0;
    if (interactive)
	MiniBuf = lbuf, DumpMiniBuf++;
    else
	lbuf[0] = '\0';
    InMiniBuf = 0;
    MLvalue -> exp_int = nkeys;
    MLvalue -> exp_type = IsString;
    MLvalue -> exp_release = 0;
    MLvalue -> exp_v.v_string = FakeIt;
    return FakeIt;
}

SelfInsertAndExit () {
    SelfInsert (-1);
    return -1;
}

ErrorAndExit () {
    error ("Aborted.");
    return -1;
}

RepeatMessage() {
    message ("%.s*s", sizeof last_message, last_message);
    return 0;
}

InitMiniBuf() {
#ifdef DumpableEmacs
    if (!Once)
#endif
    {
    	AutoHelp = 1;
	DefIntVar ("remove-help-window", &RemoveHelpWindow);
    	DefIntVar ("stack-trace-on-error", &StackTraceOnError);
    	defproc (SelfInsertAndExit, "self-insert-and-exit");
    	setkey (MinibufLocalMap, Ctl('g'), ErrorAndExit, "error-and-exit");
    }
}
mlisp.c         508527545   1094  1000  100644  32019     `
/* Unix Emacs MLisp (Mock/Minimal Lisp).
   This atrocity is used for writing extensions to Emacs.

   MLisp is Lisp without the CONS function, and all that that implies.
   (including the fact that MLisp programs are not MLisp data structures) */

/*		Copyright (c) 1981,1980 James Gosling		*/
 
/* Modified 8-Sept-81 Jeffrey Mogul (JCM) at Stanford
 *	- if we can't load "filename", try loading "filename.ml"
 */

#include "keyboard.h"
#include "macros.h"
#include "buffer.h"
#include "window.h"
#include "mlisp.h"
#include "config.h"
#include "search.h"
#include "Trm.h"
#include <ctype.h>

static FILE *MLispIn;

static char ReadMLispFileCharacter() {
    return getc(MLispIn);
}

static char peekc,		/* one character push-back */
	temp;
static	ForcedInteractive,	/* true iff next ExecProg is interactive */
	SingleStepExecute;	/* if set, single step ExecProg */

struct ProgNode *StringNode(),*NumberNode(),*ParenNode(),*NameNode();

/* ACT 21-Aug-83 Modified to include ReadMLispFileCharacter as a special
   case, as I'm assuming that gets executed several orders of magnitude
   more often than anything else */
#define next (peekc?(temp=peekc,peekc=0,temp):\
	      ReadCharacter==ReadMLispFileCharacter?getc(MLispIn):\
	      (*ReadCharacter)())

/* ParseNode parses an MLisp program node and returns a pointer to it.
   0 is returned if the parse was unsuccessful.  Getc is a function to be
   called to fetch the next character -- it should return -1 on errors. */
static struct ProgNode *
ParseNode(ReadCharacter)
char (*ReadCharacter)();

{
    register char   c;
    while (isspace (c = next) && c >= 0);
    return
	c == '('	? ParenNode (ReadCharacter) :
	c == ';'	? (LispComment(ReadCharacter),
			   ParseNode(ReadCharacter)) :
	c<0		? ((peekc=c),
			   (struct ProgNode *) 0) :
	c == ')'	? (peekc=c, (struct ProgNode *) 0) :
	c == '"'	? StringNode (ReadCharacter) :
	c == '\'' ||
	c == '-' ||
	isdigit (c)	? (peekc=c, NumberNode (ReadCharacter)) :
			  (peekc=c, NameNode (ReadCharacter));
}

/* LispComment handles lisp style comments */
LispComment(ReadCharacter)
char (*ReadCharacter)();
{
    register    c;
    while ((c = next) > 0 && c != '\n');
}

/* ParseName parses a name from the MLisp input stream */
static char *
ParseName(ReadCharacter)
char (*ReadCharacter)();
{
    static char buf[200];
    register char  *p,
                    c;
    while (isspace (c = next));
    p = buf;
    while (c > 0 && !isspace (c) && c != '(' && c != ')' && c != ';') {
	*p++ = c;
	c = next;
    }
    peekc = c;
    *p++ = 0;
    return buf[0] ? buf : 0;
}

/* release the tree 'p' */
LispFree(p)
register struct ProgNode *p;
{
    register int    n;
    if (p == 0 || p->p_active)	/* Punt freeing actively executing
				   functions */
	return;
    for (n = 0; n < p -> p_nargs; n++)
	LispFree (p -> p_args[n]);
    free (p);
}

/* parse a parenthesised node */
struct ProgNode *
ParenNode(ReadCharacter)
char (*ReadCharacter)();
{
    register    nargs = 0;
    struct ProgNode *args[200];	/* alas, yet another hard-wired
				   limitation! */
    char   *name = ParseName (ReadCharacter);
    register struct ProgNode   *p;
    register struct BoundName *who;
    int     ind;
    if (name == 0)
	return 0;
    ind = FindMac (name);
    if (ind < 0) {
	DefMac (name, (char *) 0, 1);
	ind = FindMac (name);
	if (ind < 0){
	    error ("Definition bogosity, defining %s", name);
	    return 0;
	}
    }
    who = MacBodies[ind];
    while (!err && (args[nargs] = ParseNode (ReadCharacter)))
	nargs++;
    if(peekc==')') peekc = 0;
    if (peekc < 0)
	error ("Unexpected EOF  (parens mismatched?)");
    p = (struct ProgNode   *) malloc (sizeof *p + (nargs - 1) * sizeof p);
    p -> p_proc = who;
    p -> p_nargs = nargs;
    while (--nargs >= 0)
	p -> p_args[nargs] = args[nargs];
    return p;
}

/* execute a number node */
ExecNumber () {
    MLvalue -> exp_type = IsInteger;
    MLvalue -> exp_int = (int) (CurExec -> p_args[0]);
    return 0;
}

static struct BoundName BoundNumberNode;
static struct ProgNode *
NumberNode (ReadCharacter)
char (*ReadCharacter)();
{
    register struct ProgNode   *p = (struct ProgNode   *) malloc (sizeof *p);
    register int    n = 0;
    register char   c = next;
    if (c == '\'') {
	char    buf[30];
	n = 0;
	buf[0] = next;
	while (n < 29 && ((buf[++n] = c = next) != '\''
			  || n==1 && buf[0]=='\\'));
	buf[n] = 0;
	if (n>10) goto BadChar;
	if (n == 1)
	    n = buf[0];
	else
	    if (n == 2 && buf[0] == '^')
		n = buf[1] & 037;
	    else
		if (n == 2 && buf[0] == '\\' && !isdigit (buf[1]))
		    switch (buf[1]) {
			default: 
			    n = buf[1];
			    break;
			case 'n': 
			    n = '\n';
			    break;
			case 'b': 
			    n = '\b';
			    break;
			case 't': 
			    n = '\t';
			    break;
			case 'r': 
			    n = '\r';
			    break;
		    }
		else
		    if (n > 1 && buf[0] == '\\') {
			register char  *p = buf + 1;
			register char  *lim = buf + n;
			n = 0;
			while (isdigit (c = *p++))
			    n = n * 8 + c - '0';
			if (p <= lim)
			    goto BadChar;
		    }
		    else
		BadChar: 
			error ("'%s' is an improper character constant.", buf);
    }
    else {
	register    neg = 0;
	register    base = 10;
	if (c == '-')
	    neg++, c = next;
	if (c == '0')
	    base = 8;
	while (isdigit (c)) {
	    n = n * base + c - '0';
	    c = next;
	}
	if (neg)
	    n = -n;
	peekc = c;
    }
    p -> p_proc = &BoundNumberNode;
    p -> p_nargs = 0;
    p -> p_args[0] = (struct ProgNode  *) n;
    return p;
}

static
ExecString () {
    MLvalue -> exp_type = IsString;
    MLvalue -> exp_int = (int) CurExec -> p_args[0];
    MLvalue -> exp_v.v_string = (char *) & CurExec -> p_args[1];
    return 0;
}

static struct BoundName BoundStringNode;
struct ProgNode *
StringNode (ReadCharacter)
char (*ReadCharacter)();
{
    register char  *p,
                    c;
    char    buf[300];
    register struct ProgNode   *r;
    p = buf;
    while ((c = next) > 0) {
	if (c == '\\')
	    switch (c = next) {
	    case 'n':
		c = '\n';
		break;
	    case 'b':
		c = '\b';
		break;
	    case 'r':
		c = '\r';
		break;
	    case 't':
		c = '\t';
		break;
	    case 'e':
		c = '\033';
		break;
	    case '^':
		c = next & 037;
		break;
	    default:
		if ('0'<=c && c<='7') {
		    register nc = 0;
		    register cnt = 3;
		    do nc = nc*8 + c-'0';
		    while (--cnt>0 && '0'<=(c=next) && c<='7');
		    if (cnt>0) peekc = c;
		    c = nc;
		}
	    }
	else if (c == '"' && (c = next) != '"') {
	    peekc = c;
	    break;
	}
	if (p >= &buf[sizeof buf / sizeof buf[0]]) {
	    error ("Unterminated string constant");
	    return 0;
	}
	*p++ = c;
    }
    *p++ = '\0';
    r = (struct ProgNode   *) malloc (sizeof *r + p - buf);
    r -> p_proc = &BoundStringNode;
    r -> p_nargs = 0;
    r -> p_args[0] = (struct ProgNode  *) (p - buf - 1);
    cpyn (r -> p_args + 1, buf, p - buf);
    return r;
}
/* ACT 17-Oct-1982 upgraded for single-step */

ExecProg (p)
register struct ProgNode *p;
{
    struct ProgNode *old = CurExec;
    int OldLastArg = LastArgUsed;
    int OldSingleStep = SingleStepExecute;
    register    rv = 0;
    register int WasActive;
    if (err)
	return 0;
    ReleaseExpr (MLvalue);
    MLvalue = &GlobalValue;
    GlobalValue.exp_type = IsVoid;
    if (p == 0) {
	if (old)
	    error ("\"%s\" has not been defined yet.",
		   old -> p_proc -> b_name);
	else
	    error ("Attempt to execute an undefined MLisp function.");
	return 0;
    }
    if (SingleStepExecute & 2) {
	register struct buffer *b = bf_cur;

	SetBfn ("Trace Buffer");
	InsCStr ("About to execute \"", 18);
	InsStr (p -> p_proc -> b_name);
	InsCStr ("\"", 1);
	SetBfp (b);
    }
    if (SingleStepExecute & 1) {
retell:
	CurExec = 0;
	message ("Single Step Mode: about to execute \"%s\"",
		p -> p_proc -> b_name);
again:
	switch (GetChar ()) {
	case ' ':
	    break;
	case '!':
	    OldSingleStep = 0;
	case 's':
	    SingleStepExecute = 0;
	    break;
	case 'r':
	    CurExec = old;
	    SingleStepExecute = 0;
	    RecursiveEdit ();
	    SingleStepExecute = 1;
	    goto retell;
	case 'x':
	    SingleStepExecute = 0;
	    ExecuteExtendedCommand ();
	    SingleStepExecute = 1;
	    goto again;
	case (Ctl ('G')):
	    if (SingleStepExecute & 2) {
		register struct buffer *b = bf_cur;

		SetBfn ("Trace Buffer");
		InsCStr (" Aborted\n", 9);
		SetBfp (b);
	    }
	    goto out;
	case '=':
	    goto retell;
	default:
	    message ("Options: ' '=>step; 's'=>superstep; 'r'=>recursive edit; '!'=>go; '^G'=>skip");
	    goto again;
	}
/* This message only comes out if no one overwrites it */
	message ("Single Step Done");
    }
    if (SingleStepExecute & 2) {
	register struct buffer *b = bf_cur;

	SetBfn ("Trace Buffer");
	InsCStr ("\n", 1);
	SetBfp (b);
    }
    WasActive = p->p_active;
    p->p_active = 1;
    CurExec = ForcedInteractive ? 0 : p;
    ForcedInteractive = 0;
    LastArgUsed = -1;

    rv = ExecuteBound (p -> p_proc);

    p->p_active = WasActive;
    LastArgUsed = OldLastArg;
out:
    CurExec = old;
    ForcedInteractive = 0;	/* yes, you need this one too */
    SingleStepExecute = OldSingleStep;
    return rv;
}

static bufpos;
static char getbufc () {
    register char   c;
    if (bufpos > NumCharacters)
	return - 1;
    c = CharAt (bufpos);
    bufpos++;
    return c;
}

ExecuteMLispBuffer () {
    int rv;
    bufpos = 1;
    rv = ExecuteMLispSomething (getbufc);
    if(err) SetDot (bufpos-1);
    return rv;
}

static char MLline[200];
static char
GetLineChar () {
    return MLline[bufpos] ? MLline[bufpos++] : -1;
}

ExecuteMLispLine () {
    register char  *s = getstr (": execute-mlisp-line ");
    int rv;
    if (s) {
	bufpos = 0;
	strcpyn (MLline, s, sizeof MLline / sizeof MLline[0]);
	rv = ExecuteMLispSomething (GetLineChar);
	if (interactive) {
	    if (MLvalue -> exp_type == IsInteger)
		message ("%s => %d", MLline, MLvalue -> exp_int);
	    else if (MLvalue -> exp_type == IsString)
		message ("%s => \"%s\"", MLline, MLvalue -> exp_v.v_string);
	    else if (MLvalue -> exp_type == IsMarker) {
		register struct marker *m = MLvalue -> exp_v.v_marker;
		if (m) message ("%s => (\"%s\", %d)", MLline,
				m -> m_buf -> b_name, MarkerValue (m));
	    }
	    ReleaseExpr (MLvalue);
	    MLvalue -> exp_type = IsVoid;
	}
    }
    return rv;
}

static struct BoundName *ProgNblock;
static struct BoundName BoundVariableNode;

ProgN () {
    register struct ProgNode   *p = CurExec;
    int     i,
            rv = 0;
    if (p == 0)
	error ("progn can only appear in mlisp statements");
    else {
	register struct VariableName   *v;
	register struct Binding *b;
	for (i = 0; i < p -> p_nargs && p -> p_args[i] -> p_proc == &BoundVariableNode; i++)
	    Declare (p -> p_args[i] -> p_args[0], 0);
	while (!err && rv == 0 && i < p -> p_nargs)
	    rv = ExecProg (p -> p_args[i++]);
	for (i = 0; i < p -> p_nargs && p -> p_args[i] -> p_proc == &BoundVariableNode; i++) {
	    v = (struct VariableName   *) (p -> p_args[i] -> p_args[0]);
	    b = v -> v_binding;
	    ReleaseExpr (b->b_exp);
	    free (b->b_exp);
	    b = b -> b_inner;
	    free (v -> v_binding);
	    v -> v_binding = b;
	}
    }
    return rv;
}

static
DeclareGlobal () {
    if (CurExec == 0)
	error ("declare-global can only appear in mlisp statements");
    else
	PerformDeclare (0);
    return 0;
}

static
DeclareBufferSpecific () {
    if (CurExec == 0)
	error ("declare-buffer-specific can only appear in mlisp statements");
    else
	PerformDeclare (1);
    return 0;
}

static
PerformDeclare (BufferSpecific) {
    register struct ProgNode   *p = CurExec;
    register i;
    register struct VariableName   *v;
    register struct Binding *b;
    for (i = 0; i < p -> p_nargs
	    && p -> p_args[i] -> p_proc == &BoundVariableNode; i++) {
	v = (struct VariableName   *) (p -> p_args[i] -> p_args[0]);
	if (v -> v_binding == 0 || BufferSpecific)
	    Declare (v, BufferSpecific);
    }
}

Declare (v, BufferSpecific)
register struct VariableName   *v; {
    register struct Binding *b;
    if (v -> v_binding == 0 || !BufferSpecific) {
	b = (struct Binding *) malloc (sizeof *b);
	b -> b_exp = (Expression *) malloc (sizeof (Expression));
	b -> b_exp -> exp_type = IsInteger;
	b -> b_exp -> exp_refcnt = 1;
	b -> b_exp -> exp_int = 0;
	b -> b_exp -> exp_v.v_string = (char *) - 1;
	b -> b_inner = v -> v_binding;
	v -> v_binding = b;
	b -> IsSystem = 0;
    }
    else {
	b = v -> v_binding;
	while (b -> b_inner)
	    b = b -> b_inner;
	if (b -> IsSystem)
	    return;
    }
    b -> BufferSpecific = BufferSpecific;
    b -> IsDefault = BufferSpecific;
}

static
IsBound () {
    register struct ProgNode   *p = CurExec;
    int     i;
    if (p == 0)
	error ("is-bound can only appear in mlisp statements");
    else {
	register struct VariableName   *v;
	MLvalue -> exp_type = IsInteger;
	MLvalue -> exp_int = 1;
	for (i = 0; i < p -> p_nargs && p -> p_args[i] -> p_proc == &BoundVariableNode; i++) {
	    v = (struct VariableName   *) (p -> p_args[i] -> p_args[0]);
	    if (!v -> v_binding) {
		MLvalue -> exp_int = 0;
		break;
	    }
	}
    }
    return 0;
}

static
ErrorOccured () {
    register rv = ProgN ();
    ReleaseExpr (MLvalue);
    MLvalue -> exp_type = IsInteger;
    MLvalue -> exp_int = err!=0;
    err = 0;
    MiniBuf = "";
    return rv;
}

static
PrefixArgumentLoop () {
    register int rv = 0;
    register int ctr = ExecutionRoot.PrefixArgument;
    while (--ctr>=0 && !err && rv==0)
	rv = ProgN ();
    return rv;
}

static
SaveWindowExcursion () {

#define SaveSize 30

    int      WinSize[SaveSize], rv, current = -1, oldheight;
    register k, nsaved = 0;
    struct marker *WinMark[SaveSize],
		  *WinTop[SaveSize];
    register struct window *w, *nextw;
    register struct buffer *old = bf_cur;
    struct marker *olddot = NewMark(); /* fix by mkc: was being forgotten */
    SetMark(olddot,bf_cur,dot);

    for (w = windows; w -> w_next && nsaved < SaveSize; w = w -> w_next) {
	WinSize[nsaved] = w -> w_height;
	if (w == wn_cur)
	    current = nsaved;
	SetMark (WinMark[nsaved] = NewMark (), w->w_buf, ToMark(w->w_dot));
	SetMark (WinTop[nsaved++] = NewMark (), w->w_buf, ToMark(w->w_start));
    }
    oldheight = tt.t_length;
    SetBfp (old);		/* ToMark got us to the wrong buffer */
    rv = SaveExcursion ();
/*    if (oldheight != tt.t_length)
	ChangeScreenHeight(oldheight);
*/
    k = 0;
    for (w = windows; nextw = w -> w_next; w = nextw) {
	if (k >= nsaved)
	    DelWin (w);
	k++;
    }
    while (k < nsaved) {
	SplitLargestWindow ();
	k++;
    }

    for (k = 0, w = windows; k < nsaved; k++, w = w -> w_next) {
	ChgWHeight (w, WinSize[k] - w->w_height, 0);
	TieWin (w, WinTop[k] -> m_buf);
	/* Position first line in window */
	SetMark (w -> w_start, w -> w_buf, ToMark (WinTop[k]));
	DestMark (WinTop[k]);
	dot = ToMark (WinMark[k]);
	SetMark (w -> w_dot, w -> w_buf, dot);
	DestMark (WinMark[k]);
    }
    if (current < 0) {		/* in minibuffer */
	for (w = windows; w -> w_next; w = w -> w_next)
	    ;
	SetWin (w);
    }
    else {
	for (k = 0, w = windows; k < current; k++, w = w -> w_next)
	    ;
	SetWin (w);
    }
    dot = ToMark(olddot); /* the restore in SaveExcursion is not sufficient */
    DestMark(olddot);
    return rv;
}

static
SaveExcursion () {
    register struct marker *olddot = NewMark ();
    register struct marker *oldmark = 0;
    register struct buffer *oldbuf = bf_cur;
    int BufferVisible = wn_cur->w_buf == bf_cur;
    register    rv;
    struct search_globals lglobals;

    SetMark (olddot, bf_cur, dot);
    if (bf_cur -> b_mark) {
	oldmark = NewMark ();
	SetMark (oldmark, bf_cur, ToMark (bf_cur -> b_mark));
    }
    lglobals = search_globals;
    rv = ProgN ();
    search_globals = lglobals;
    SetBfp (oldbuf);
    if(BufferVisible) WindowOn (bf_cur);
    dot = ToMark (olddot);
    if (oldmark) {
	SetMark (bf_cur -> b_mark, bf_cur, ToMark (oldmark));
	DestMark (oldmark);
    }
    DestMark (olddot);
    return rv;
}

static
If () {
    register    i;
    if (CheckArgs (2, 0))
	return 0;
    for (i = 0; !err && i + 1 < CurExec -> p_nargs; i += 2)
	if (NumericArg (i + 1))
	    return ExecProg (CurExec -> p_args[i + 1]);
    return !err && i < CurExec -> p_nargs
	? ExecProg (CurExec -> p_args[i]) : 0;
}

static
While () {
    register    i, rv = 0;
    if (CheckArgs (2, 0))
	return 0;
    while (!err && rv==0
	    && (rv=ExecProg (CurExec -> p_args[0]))==0
	    && MLvalue -> exp_type == IsInteger
	    && MLvalue -> exp_int
	    && !err)
	for (i = 1; rv==0 && i < CurExec -> p_nargs && !err; i++)
	    rv = ExecProg (CurExec -> p_args[i]);
    return rv;
}

static
CallInteractively () {
    register rv = 0;

    if (CheckArgs (1, 1))
	return 0;
    ForcedInteractive++;
    rv = ExecProg (CurExec -> p_args[0]);
    return rv;
}

static
InsertString () {
    if (CurExec) {
	register    i = 1;
	while (i <= CurExec -> p_nargs && StringArg (i)) {
	    InsCStr (MLvalue -> exp_v.v_string, MLvalue -> exp_int);
	    i++;
	}
    }
    else {
	register char  *s = getstr (": insert-string ");
	if (s == 0)
	    return 0;
	InsStr (s);
    }
    return 0;
}

static
Message () {
    Concat ();
    if (err)
	return 0;
    CurExec = 0;
    if(!err)
	message ("%s", MLvalue -> exp_v.v_string);
    VoidResult ();
    return 0;
}

static
SendStringToTerminal () {
    register char *s = getstr (": send-string-to-terminal ");
    if(s) vputs (s);
    VoidResult ();
    return 0;
}

static
ErrorMessage () {
    Concat ();
    if (err)
	return 0;
    error ("%s", MLvalue -> exp_v.v_string);
    VoidResult ();
    return 0;
}

static
ExecuteMLispSomething (ReadCharacter)
char (*ReadCharacter)();
{
    register struct ProgNode   *p;
    int rv;
    peekc = 0;
    if ((p = ParseNode (ReadCharacter)) == 0)
	return 0;
    rv = ExecProg (p);
    LispFree (p);
    return rv;
}

ExecuteMLispFile (fn, MissingOK)
char *fn;
{
    register char   c;
    char    fnb[MaxPathNameLen];
    FILE * old = MLispIn;
    register rv = 0;
    peekc = 0;
    if ((MLispIn = fopenp (LoadSearchPath, fn, fnb, "r")) == NULL){
    	/* couldn't open fn; let's try fn.ml */
	char Xfn[MaxPathNameLen];
	strcpy(Xfn,fn);
	strcat(Xfn,".ml");
	MLispIn = fopenp (LoadSearchPath, Xfn, fnb, "r");
	}

    if (MLispIn == NULL) {
    	/* still null?  Guess file isn't there */
	if(!MissingOK) error ("Can't read %s", fn);
	rv++;
	peekc = -1;
    }
    else
	peekc = getc (MLispIn);
    if (peekc == '\033')
	LoadFile (fn);
    else
	while (peekc >= 0 && !err) {
	    register struct ProgNode   *p =
		ParseNode (ReadMLispFileCharacter);
	    if (p == 0)
		break;
	    ExecProg (p);
	    LispFree (p);
	    while (isspace (c = getc (MLispIn)) && c > 0);
	    peekc = c;
	};
    if (MLispIn)
	fclose (MLispIn);
    MLispIn = old;
    return rv | err;
}

static
ExecuteMLispFileTOP () {
    register char *s = getstr(": execute-mlisp-file ");
    if(s) ExecuteMLispFile (s, 0);
}

/* release the storage associated with an expression */
DoRelease (e)
register Expression *e; {
    if (e -> exp_release) {
	switch (e -> exp_type) {
	    case IsString: 
		free (e -> exp_v.v_string);
		e -> exp_v.v_string = 0;
	    default: 
		break;
	    case IsMarker: 
		DestMark (e -> exp_v.v_marker);
		e -> exp_v.v_marker = 0;
		break;
	}
	e -> exp_release = 0;
    }
}

static
DefineFunction () {
    register struct ProgNode *p;
    register struct BoundName  *b;
    register int    i;
    if (CheckArgs (1, 0))
	return 0;
    for (i = 0; i < CurExec -> p_nargs; i++)
	if (p = CurExec -> p_args[i]) {
	    CurExec -> p_args[i] = 0;
	    b = p -> p_proc;
	    if (b -> b_binding == MLispBound)
		LispFree (b -> b_bound.b_prog);
	    else
		if (b -> b_binding == MacroBound
			|| b -> b_binding == AutoLoadBound) {
		    free (b -> b_bound.b_body);
		    b -> b_binding = MLispBound;
		}
		else {
		    error ("\"%s\" is bound to a wired procedure and cannot be rebound!", b -> b_name);
		    continue;
		}
	    b -> b_bound.b_prog = p;
	    p -> p_proc = ProgNblock;
	}
    return 0;
}

struct VariableName *Lookup (name)
char *name;
{
    register    i;
    char   *p1,
           *p2;
    for (i = 0; i < NVars; i++) {
	p1 = VarNames[i];
	p2 = name;
	while (*p2 && *p1 == *p2)
	    p1++, p2++;
	if ((*p1 | *p2) == 0)	/* *p1==0 && *p2==0 */
	    return VarDesc[i];
    }
    return 0;
}

static				/* define a varible name given the string
				   name and a pointer to the descriptor
				   record */
Define(name,desc)
char *name;
struct VariableName *desc;
{
    if (NVars+1 >= VarTSize-1)	/* enlarge the string table */
	if (VarTSize==0) {
	    VarNames = (char **) malloc ((VarTSize = 50) * sizeof *VarNames);
	    VarDesc = (struct VariableName **)
		malloc (VarTSize * sizeof *VarDesc);
	}
	else {
	    VarNames = (char **)
		realloc (VarNames, (VarTSize += 50) * sizeof *VarNames);
	    VarDesc = (struct VariableName **)
		realloc (VarDesc, VarTSize * sizeof *VarDesc);
	}
    VarNames[NVars] = name;
    VarDesc[NVars] = desc;
    NVars++;
    VarDesc[NVars] = 0;
    VarNames[NVars] = 0;
}

static struct ProgNode *	/* parse a name token in an MLisp program */
NameNode (ReadCharacter)
char (*ReadCharacter)(); {
    register struct ProgNode   *p = (struct ProgNode   *) malloc (sizeof *p);
    register char  *name = ParseName (ReadCharacter);
    register struct VariableName   *v;
    if ((v = Lookup (name)) == 0) {
	v = (struct VariableName   *) malloc (sizeof *v);
	Define (v -> v_name = savestr (name), v);
	v -> v_binding = 0;
    }
    p -> p_nargs = 0;
    p -> p_args[0] = (struct ProgNode  *) v;
    p -> p_proc = &BoundVariableNode;
    return p;
}

struct Binding *ResolveBufferSpecific (b)
register struct Binding *b; {
    if (b -> BufferSpecific) {
	while (b && !b -> IsDefault && b -> BufferSpecific
		&& b -> b.b_LocalTo != bf_cur)
	    b = b -> b_inner;
	if (!b || !b -> BufferSpecific) {
	    error ("Error resolving buffer-specific variable (internal error)");
	    return 0;		/* This should never happen! */
	}
    }
    return b;
}

struct Binding *ResolveBufferSpecificAssignment (b, v)
register struct Binding *b;
register struct VariableName *v; {
    if ((b = ResolveBufferSpecific (b)) == 0)
	return 0;
    if (b -> IsDefault) {
	b = (struct Binding *) malloc (sizeof *b);
	b -> b_exp = (Expression *) malloc (sizeof (Expression));
	b -> b_exp -> exp_type = IsInteger;
	b -> b_exp -> exp_int = 0;
	b -> b_exp -> exp_refcnt = 1;
	b -> IsSystem = 0;
	b -> BufferSpecific = 1;
	b -> IsDefault = 0;
	b -> b.b_LocalTo = bf_cur;
	b -> b_exp -> exp_v.v_string = (char *) - 1;
	b -> b_inner = v -> v_binding;
	v -> v_binding = b;
    }
    return b;
}

ExecVariable () {
    register struct VariableName   *v =
                                    (struct VariableName   *) (CurExec -> p_args[0]);
    register struct Binding *b;
    if ((b = v -> v_binding) == 0)
	error ("Reference to an unbound variable: \"%s\"", v -> v_name);
    else {
	if (b -> BufferSpecific && (b = ResolveBufferSpecific (b)) == 0)
	    return 0;
	MLvalue -> exp_type = b -> b_exp -> exp_type;
	MLvalue -> exp_int = b -> b_exp -> exp_int;
	switch (MLvalue -> exp_type) {
	    case IsString: 
		MLvalue -> exp_release = 1;
		MLvalue -> exp_v.v_string =
		    (char *) malloc (MLvalue -> exp_int + 1);
		strcpyn (MLvalue -> exp_v.v_string,
			b -> b_exp -> exp_v.v_string, MLvalue -> exp_int + 1);
		if (b -> IsSystem)
		    MLvalue -> exp_int =
			strlen (MLvalue -> exp_v.v_string);
		break;
	    case IsInteger: 
		MLvalue -> exp_release = 0;
		MLvalue -> exp_v.v_string = 0;
		if (b -> IsSystem)
		    MLvalue -> exp_int = *(int *) b -> b_exp -> exp_v.v_string;
		break;
	    case IsMarker: 
		MLvalue -> exp_release = 1;
		MLvalue -> exp_v.v_marker =
		    CopyMark (NewMark (), b -> b_exp -> exp_v.v_marker);
		break;
	    default: 
		error ("Variable \"%s\" has a bizarre type!", v -> v_name);
	}
    }
    return 0;
}

static
SetQ () {
    return DoSetQ (0);
}

static
SetQDefault () {
    return DoSetQ (1);
}

static
DoSetQ (Default) {
    register struct ProgNode   *p;
    register struct Binding *b;
    if (CheckArgs (2, 2))
	return 0;
    if ((p = CurExec -> p_args[0]) -> p_proc != &BoundVariableNode)
	error ("setq expects its first argument to be a variable name.");
    else
	PerformSet (p -> p_args[0], 2, 0, Default);
    return 0;
}

Set () {
    return DoSet (0);
}

SetDefault () {
    return DoSet (1);
}

DoSet (Default) {
    register    n;
    register char  *p;
    register struct VariableName   *v;
    if (VarNames == 0) {
	error ("You've got to be kidding...");
	return 0;
    }
    if (Default) {
	register char  *name = getstr (": set-default ");
	if (name == 0)
	    return 0;
	if ((v = Lookup (name)) == 0) {
	    v = (struct VariableName   *) malloc (sizeof *v);
	    Define (v -> v_name = savestr (name), v);
	    v -> v_binding = 0;
	}
    }
    else {
	n = getword (VarNames, ": set ");
	if (n < 0)
	    return 0;
	v = VarDesc[n];
    }
    /* ACT 18-Oct-1982 Added code to test CurExec and use getstr only if
       interactive, otherwise use PerformSet (v, 2, 0, Default) */
    if (CurExec == 0) {
	p = getstr (": set%s %s ", Default ? "-default" : "", v->v_name);
	if (p == 0)
	    return 0;
	PerformSet (v, 0, p, Default);
    }
    else
	PerformSet (v, 2, 0, Default);
    return 0;
}

/* Assign the arg'th expression to v, if arg==0 then the string
   "svalue" will be used */
PerformSet (v, arg, svalue, SettingDefault)
register struct VariableName *v;
char   *svalue; {
    register struct Binding *b = v -> v_binding;
    if (SettingDefault && b==0) {
	Declare (v, 0);
	b = v -> v_binding;
    }
    if (b == 0) {
	error ("Attempt to set the unbound variable \"%s\"", v -> v_name);
	return;
    }
    if (SettingDefault) {
	while (b -> b_inner && !b -> IsDefault) b = b -> b_inner;
	if (b -> IsSystem && b -> b.b_Default) b = b -> b.b_Default;
    }	
/* There should be a general way to check values assigned to system
   variables. */
    if (b -> IsSystem) {
	if (b -> b_exp -> exp_type == IsInteger)
	    *(int *) b -> b_exp -> exp_v.v_string =
		arg ? NumericArg (arg) : StrToInt (svalue);
	else
	    if (arg==0 || StringArg (arg)) {
		strcpyn (b -> b_exp -> exp_v.v_string,
			arg ? MLvalue -> exp_v.v_string : svalue,
			b -> b_exp -> exp_int);
		b -> b_exp -> exp_v.v_string[b -> b_exp -> exp_int - 1]
		    = 0;
          }
	Cant1WinOpt++;
	bf_cur -> b_mode = bf_mode;
    }
    else {
	if (b -> BufferSpecific
		&& (b = ResolveBufferSpecificAssignment (b, v)) == 0)
	    return 0;
	if (arg == 0) {
	    ReleaseExpr (b -> b_exp);
	    b -> b_exp -> exp_int = strlen (svalue);
	    b -> b_exp -> exp_type = IsString;
	    b -> b_exp -> exp_v.v_string = savestr (svalue);
	    b -> b_exp -> exp_release = 1;
	}
	else {
	    if (!EvalArg (2))
		return 0;
	    ReleaseExpr (b -> b_exp);
	    b -> b_exp -> exp_int = MLvalue -> exp_int;
	    b -> b_exp -> exp_type = MLvalue -> exp_type;
	    switch (MLvalue -> exp_type) {
		case IsString: 
		    if (MLvalue -> exp_release) {
			MLvalue -> exp_release = 0;
			b -> b_exp -> exp_v.v_string = MLvalue -> exp_v.v_string;
		    }
		    else
			b -> b_exp -> exp_v.v_string =
			    savestr (MLvalue -> exp_v.v_string);
		    b -> b_exp -> exp_release = 1;
		    break;
		case IsMarker: 
		    if (MLvalue -> exp_release) {
			b -> b_exp -> exp_v.v_marker = MLvalue -> exp_v.v_marker;
			MLvalue -> exp_release = 0;
		    }
		    else
			b -> b_exp -> exp_v.v_marker =
			    CopyMark (NewMark (), MLvalue -> exp_v.v_marker);
		    b -> b_exp -> exp_release = 1;
		    break;
		default: 
		    b -> b_exp -> exp_v.v_string = 0;
		    b -> b_exp -> exp_release = 0;
	    }
	}
    }
}

static
Print () {
    register    n;
    register struct Binding *b;
    if (VarNames == 0)
	error ("You've got to be kidding!");
    else {
	n = getword (VarNames, ": print ");
	if (n >= 0) {
	    b = VarDesc[n] -> v_binding;
	    if (b -> BufferSpecific) b = ResolveBufferSpecific (b);
	    if (b == 0)
		error ("%s isn't bound to a value.", VarNames[n]);
	    else
		switch (b -> b_exp -> exp_type) {
		    case IsInteger: 
			message (": print %s => %d", VarNames[n],
				b -> IsSystem ? *(int *) b -> b_exp -> exp_v.v_string
				: b -> b_exp -> exp_int);
			break;
		    case IsString: 
			message (": print %s => \"%s\"",
				VarNames[n], b -> b_exp -> exp_v.v_string);
			break;
		    case IsMarker: {
			    register struct marker *m = b -> b_exp -> exp_v.v_marker;
			    if (m) message (": print %s => Marker (\"%s\", %d)",
				VarNames[n],
				m -> m_buf -> b_name,
				ToMark (m));
			    break;
			}
		    default: 
			error (": print %s => Something very odd!",
				VarNames[n]);
		}
	}
    }
    return 0;
}

static ProvidePrefixArgument () {
    if (CheckArgs(2, 2)) return 0;
    arg = NumericArg (1);
    ArgState = PreparedArg;
    return err ? 0 : ExecProg (CurExec -> p_args[1]);
}

static ReturnPrefixArgument () {
    arg = getnum (": return-prefix-argument ");
    ArgState = PreparedArg;
    return 0;
}

/* print out an MLisp expression (de-compile it) into the current buffer */
PrintExpr (p, depth)
register struct ProgNode   *p; {
    register struct BoundName  *n;
    if (p == 0) {
	InsStr ("<<Command Level>>");
	return;
    }
    n = p -> p_proc;
    if (n == &BoundNumberNode) {
	char    buf[50];
	sprintfl (buf, sizeof buf, "%d", p -> p_args[0]);
	InsStr (buf);
	return;
    }
    if (n == &BoundStringNode) {
	InsCStr ("\"", 1);
	InsCStr (p -> p_args + 1, p -> p_args[0]);
	InsCStr ("\"", 1);
	return;
    }
    if (n == &BoundVariableNode) {
	InsStr (((struct VariableName  *) p -> p_args[0]) -> v_name);
	return;
    }
    InsCStr ("(", 1);
    if (depth>=0) {
	register i;
	InsStr (n->b_name);
	for(i=0; i<p->p_nargs; i++) {
	    InsCStr (" ", 1);
	    PrintExpr (p->p_args[i], depth-1);
	}
    }
    InsCStr (")", 1);
}

/* Throw away any expression evaluation so that the current function returns
   no value */
VoidResult () {
    ReleaseExpr (MLvalue);
    MLvalue -> exp_type = IsVoid;
}

InitLisp () {
/* The following variables should really be considered private to the
   modules that define them.  They are here only so that they can be
   set from command level and are NOT in .h files since they aren't
   intended for general use. */

    extern  TrackEol;		/* true iff ^n and ^p should stick with
				   eol's */
    extern  AutoHelp;		/* true iff ambiguous or misspelled
				   words should create a help window
				   (DJH) */
#ifdef DumpableEmacs
    if (!Once)
#endif
    {
	DefIntVar ("track-eol-on-^N-^P", &TrackEol);
	DefIntVar ("ctlchar-with-^", &CtlArrow);
	DefIntVar ("help-on-command-completion-error", &AutoHelp);

	BoundNumberNode.b_bound.b_proc = ExecNumber;
	BoundNumberNode.b_name = "execute-number";
	BoundVariableNode.b_bound.b_proc = ExecVariable;
	BoundVariableNode.b_name = "execute-variable";
	BoundStringNode.b_bound.b_proc = ExecString;
	BoundStringNode.b_name = "execute-string";
	defproc (SetQ, "setq");
	defproc (SetQDefault, "setq-default");
	defproc (Print, "print");
	defproc (DeclareGlobal, "declare-global");
	defproc (DeclareBufferSpecific, "declare-buffer-specific");
	defproc (IsBound, "is-bound");
	defproc (PrefixArgumentLoop, "prefix-argument-loop");
	defproc (Set, "set");
	defproc (SetDefault, "set-default");
	defproc (ExecuteMLispBuffer, "execute-mlisp-buffer");
	defproc (ExecuteMLispFileTOP, "execute-mlisp-file");
	setkey (ESCmap, (033), ExecuteMLispLine, "execute-mlisp-line");
	defproc (ProgN, "progn");
	ProgNblock = *(NewNames - 1);
	defproc (If, "if");
	defproc (While, "while");
	defproc (CallInteractively, "call-interactively");
	defproc (InsertString, "insert-string");
	defproc (ProvidePrefixArgument, "provide-prefix-argument");
	defproc (ReturnPrefixArgument, "return-prefix-argument");
	defproc (DefineFunction, "defun");
	defproc (ErrorOccured, "error-occured");
	defproc (SaveExcursion, "save-excursion");
	defproc (SaveWindowExcursion, "save-window-excursion");
	defproc (Message, "message");
	defproc (SendStringToTerminal, "send-string-to-terminal");
	defproc (ErrorMessage, "error-message");
	DefIntVar ("single-step-execution", &SingleStepExecute);
    }
}

ndbm.c          508005727   1094  1000  100644  13636     `
#include	"ndbm.h"
#include	<sys/types.h>
#include	<sys/stat.h>

static datum nulldatum;

database *open_db (file)
char   *file;
{
    struct stat statb;
    register    database * db = (database *) malloc (sizeof *db);
    register int    len;

    len = strlen (file);
    db -> dirnm = (char *) malloc (4 * (len + 5));
    db -> pagnm = db -> dirnm + len + 5;
    db -> datnm = db -> pagnm + len + 5;
    db -> dbnm  = db -> datnm + len + 5;
    strcpy (db -> dirnm, file);
    strcpy (db -> dirnm + len, ".dir");
    strcpy (db -> pagnm, file);
    strcpy (db -> pagnm + len, ".pag");
    strcpy (db -> datnm, file);
    strcpy (db -> datnm + len, ".dat");
    strcpy (db -> dbnm,  file);
    db -> oldpagb = -1;
    db -> olddirb = -1;
    if (setup_db (db) < 0) {
	free (db -> dirnm);
	free (db);
	return 0;
    }
    fstat (db -> dirf, &statb);
    db -> maxbno = statb.st_size * BYTESIZ - 1;
    return (db);
}

free_db (db)
register    database * db; {
    if (db == 0)
	return 40;
    if (lastdatabase == db) {
	if (db -> dirf > 0)
	    close (db -> dirf);
	if (db -> pagf > 0)
	    close (db -> pagf);
	if (db -> datf > 0)
	    close (db -> datf);
	db -> dirf = -1;
	db -> pagf = -1;
	db -> datf = -1;
	lastdatabase = 0;
    }
    free (db -> dirnm);
    free (db);
    return 0;
}

static setup_db (db)
register    database * db; {
    if (db==0) return -1;
    if (lastdatabase == db)
	return 0;
    if (lastdatabase) {
	if (lastdatabase -> dirf > 0)
	    close (lastdatabase -> dirf);
	if (lastdatabase -> pagf > 0)
	    close (lastdatabase -> pagf);
	if (lastdatabase -> datf > 0)
	    close (lastdatabase -> datf);
	lastdatabase -> dirf = -1;
	lastdatabase -> pagf = -1;
	lastdatabase -> datf = -1;
	lastdatabase = 0;
    }
    db -> dirf = open (db -> dirnm, 2);
    db -> dbrdonly = 0;
    if (db -> dirf < 0) {
	db -> dbrdonly = 1;
	db -> dirf = open (db -> dirnm, 0);
    }
    db -> pagf = open (db -> pagnm, db -> dbrdonly ? 0 : 2);
    db -> datf = open (db -> datnm, db -> dbrdonly ? 0 : 2);
    if (db -> dirf < 0 || db -> pagf < 0 || db -> datf < 0) {
	close (db -> dirf);
	close (db -> pagf);
	close (db -> datf);
	return - 1;
    }
    lastdatabase = db;
    return 0;
}

long
        forder (key, db)
register    database * db;
datum key;
{
    long    hash;

/*  if (setup_db (db)<0) return -1; */
    hash = calchash (key);
    for (db -> hmask = 0;; db -> hmask = (db -> hmask << 1) + 1) {
	db -> blkno = hash & db -> hmask;
	db -> bitno = db -> blkno + db -> hmask;
	if (getbit (db) == 0)
	    break;
    }
    return (db -> blkno);
}

datum
fetch (key, db)
register    database * db;
datum key;
{
    register    i;
    datum item;

/*  if (setup_db (db) < 0) return nulldatum; */
    ndbm_access (calchash (key), db);
    for (i = 0;; i ++) {
	item = makdatum (db -> pagbuf, i);
	if (item.dptr == 0)
	    return (item);
	if (cmpdatum (key, item) == 0) {
	    return (item);
	}
    }
}

delete (key, db)
register    database * db;
datum key;
{
    register    i;
    datum item;

/*  if (setup_db (db) < 0) return -1; */
    if (db -> dbrdonly)
	return - 1;
    ndbm_access (calchash (key), db);
    for (i = 0;; i ++) {
	item = makdatum (db -> pagbuf, i);
	if (item.dptr == 0)
	    return (-1);
	if (cmpdatum (key, item) == 0) {
	    delitem (db -> pagbuf, i);
	    break;
	}
    }
    setup_db (db);
    lseek (db -> pagf, db -> blkno * PBLKSIZ, 0);
    write (db -> pagf, db -> pagbuf, PBLKSIZ);
    return (0);
}

store (key, db)
register    database * db;
datum key;
{
    register    i;
    datum item;
    char    ovfbuf[PBLKSIZ];

    if (setup_db (db) < 0) return -1;
    if (db -> dbrdonly)
	return - 1;
loop: 
    ndbm_access (calchash (key), db);
    for (i = 0;; i ++) {
	item = makdatum (db -> pagbuf, i);
	if (item.dptr == 0)
	    break;
	if (cmpdatum (key, item) == 0) {
	    delitem (db -> pagbuf, i);
	    break;
	}
    }
    i = additem (db -> pagbuf, key);
    if (i < 0)
	goto split;
    lseek (db -> pagf, db -> blkno * PBLKSIZ, 0);
    write (db -> pagf, db -> pagbuf, PBLKSIZ);
    return (0);

split: 
    if (key.dsize + 2*sizeof (long) + 2 * sizeof (short) >= PBLKSIZ)
	return (-1);
    clrbuf (ovfbuf, PBLKSIZ);
    for (i = 0;;) {
	item = makdatum (db -> pagbuf, i);
	if (item.dptr == 0)
	    break;
	if (calchash (item) & (db -> hmask + 1)) {
	    additem (ovfbuf, item);
	    delitem (db -> pagbuf, i);
	    continue;
	}
	i ++;
    }
    lseek (db -> pagf, db -> blkno * PBLKSIZ, 0);
    write (db -> pagf, db -> pagbuf, PBLKSIZ);
    lseek (db -> pagf, (db -> blkno + db -> hmask + 1) * PBLKSIZ, 0);
    write (db -> pagf, ovfbuf, PBLKSIZ);
    setbit (db);
    goto loop;
}

datum
firstkey (db)
register database *db;
{
/*  return setup_db (db)<0 ? nulldatum : (firsthash (0L, db)); */
    return firsthash (0L, db);
}

datum
nextkey (key, db)
register    database * db;
datum key;
{
    register    i;
    datum item, bitem;
    long    hash;
    int     f;

/*  if (setup_db (db) < 0) return nulldatum; */
    hash = calchash (key);
    ndbm_access (hash, db);
    f = 1;
    for (i = 0;; i ++) {
	item = makdatum (db -> pagbuf, i);
	if (item.dptr == 0)
	    break;
	if (cmpdatum (key, item) <= 0)
	    continue;
	if (f || cmpdatum (bitem, item) < 0) {
	    bitem = item;
	    f = 0;
	}
    }
    if (f == 0)
	return (bitem);
    hash = hashinc (hash, db);
    if (hash == 0)
	return (item);
    return (firsthash (hash, db));
}

datum
firsthash (hash, db)
register    database * db;
long    hash;
{
    register    i;
    datum item, bitem;

loop: 
    ndbm_access (hash, db);
    bitem = makdatum (db -> pagbuf, 0);
    for (i = 0;; i ++) {
	item = makdatum (db -> pagbuf, i);
	if (item.dptr == 0)
	    break;
	if (cmpdatum (bitem, item) < 0)
	    bitem = item;
    }
    if (bitem.dptr != 0)
	return (bitem);
    hash = hashinc (hash, db);
    if (hash == 0)
	return (item);
    goto loop;
}

static
ndbm_access (hash, db)
register    database * db;
long    hash;
{
    for (db -> hmask = 0;; db -> hmask = (db -> hmask << 1) + 1) {
	db -> blkno = hash & db -> hmask;
	db -> bitno = db -> blkno + db -> hmask;
	if (getbit (db) == 0)
	    break;
    }
    if (db -> blkno != db -> oldpagb) {
	clrbuf (db -> pagbuf, PBLKSIZ);
	setup_db (db);
	lseek (db -> pagf, db -> blkno * PBLKSIZ, 0);
	read (db -> pagf, db -> pagbuf, PBLKSIZ);
	chkblk (db -> pagbuf);
	db -> oldpagb = db -> blkno;
    }
}

static
getbit (db)
register    database * db;
{
    long    bn;
    register    b,
                i,
                n;

    if (db -> bitno > db -> maxbno)
	return (0);
    n = db -> bitno % BYTESIZ;
    bn = db -> bitno / BYTESIZ;
    i = bn % DBLKSIZ;
    b = bn / DBLKSIZ;
    if (b != db -> olddirb) {
	clrbuf (db -> dirbuf, DBLKSIZ);
	setup_db (db);
	lseek (db -> dirf, (long) b * DBLKSIZ, 0);
	read (db -> dirf, db -> dirbuf, DBLKSIZ);
	db -> olddirb = b;
    }
    if (db -> dirbuf[i] & (1 << n))
	return (1);
    return (0);
}

static
setbit (db)
register    database * db;
{
    long    bn;
    register    i,
                n,
                b;

    if (db -> dbrdonly)
	return - 1;
    if (db -> bitno > db -> maxbno) {
	db -> maxbno = db -> bitno;
	getbit (db);
    }
    n = db -> bitno % BYTESIZ;
    bn = db -> bitno / BYTESIZ;
    i = bn % DBLKSIZ;
    b = bn / DBLKSIZ;
    db -> dirbuf[i] |= 1 << n;
    setup_db (db);
    lseek (db -> dirf, (long) b * DBLKSIZ, 0);
    write (db -> dirf, db -> dirbuf, DBLKSIZ);
    return 0;
}

static
clrbuf (cp, n)
register char  *cp;
register    n;
{

    do
	*cp++ = 0;
    while (--n);
}

static datum
makdatum (buf, n)
char    buf[PBLKSIZ];
{
    register short *sp;
    register    t;
    register long *lp;
    datum item;

    sp = (short *) buf;
    if (n < 0 || n >= sp[0])
	goto null;
    t = PBLKSIZ;
    if (n > 0)
	t = sp[n + 1 - 1];
    lp = (long *) (buf + sp[n + 1]);
#ifdef vax
    item.val1 = *lp++;
    item.val2 = *lp++;
#else
    {
	register unsigned char *p = (unsigned char *) lp;
	item.val1 = (p[3] << 24) | (p[2] << 16) | (p[1] << 8) | p[0];
	p = (unsigned char *) ++lp;
	item.val2 = (p[3] << 24) | (p[2] << 16) | (p[1] << 8) | p[0];
	lp++;
    }
#endif
    item.dptr = (char *) lp;
    item.dsize = t - sp[n + 1] - 2*sizeof(long);
    return (item);

null: 
    item.dptr = 0;
    item.dsize = 0;
    return (item);
}

static
cmpdatum (d1, d2)
datum d1, d2;
{
    register    n;
    register char  *p1,
                   *p2;

    n = d1.dsize;
    if (n != d2.dsize)
	return (n - d2.dsize);
    if (n == 0)
	return (0);
    p1 = d1.dptr;
    p2 = d2.dptr;
    do
	if (*p1++ != *p2++)
	    return (*--p1 - *--p2);
    while (--n);
    return (0);
}

int     hitab[16]
/* ken's {
   055,043,036,054,063,014,004,005,
   010,064,077,000,035,027,025,071, }; */
= {
    61, 57, 53, 49, 45, 41, 37, 33,
    29, 25, 21, 17, 13, 9, 5, 1,
};
long    hltab[64]
= {
    06100151277L, 06106161736L, 06452611562L, 05001724107L,
    02614772546L, 04120731531L, 04665262210L, 07347467531L,
    06735253126L, 06042345173L, 03072226605L, 01464164730L,
    03247435524L, 07652510057L, 01546775256L, 05714532133L,
    06173260402L, 07517101630L, 02431460343L, 01743245566L,
    00261675137L, 02433103631L, 03421772437L, 04447707466L,
    04435620103L, 03757017115L, 03641531772L, 06767633246L,
    02673230344L, 00260612216L, 04133454451L, 00615531516L,
    06137717526L, 02574116560L, 02304023373L, 07061702261L,
    05153031405L, 05322056705L, 07401116734L, 06552375715L,
    06165233473L, 05311063631L, 01212221723L, 01052267235L,
    06000615237L, 01075222665L, 06330216006L, 04402355630L,
    01451177262L, 02000133436L, 06025467062L, 07121076461L,
    03123433522L, 01010635225L, 01716177066L, 05161746527L,
    01736635071L, 06243505026L, 03637211610L, 01756474365L,
    04723077174L, 03642763134L, 05750130273L, 03655541561L,
};

static long
        hashinc (hash, db)
register    database * db;
long    hash;
{
    long    bit;

    hash &= db -> hmask;
    bit = db -> hmask + 1;
    for (;;) {
	bit >>= 1;
	if (bit == 0)
	    return (0L);
	if ((hash & bit) == 0)
	    return (hash | bit);
	hash &= ~bit;
    }
}

static long
        calchash (item)
        datum item;
{
    register    i,
                j,
                f;
    long    hashl;
    int     hashi;

    hashl = 0;
    hashi = 0;
    for (i = 0; i < item.dsize; i++) {
	f = item.dptr[i];
	for (j = 0; j < BYTESIZ; j += 4) {
	    hashi += hitab[f & 017];
	    hashl += hltab[hashi & 63];
	    f >>= 4;
	}
    }
    return (hashl);
}

static
delitem (buf, n)
char    buf[PBLKSIZ];
{
    register short *sp;
    register    i1,
                i2,
                i3;

    sp = (short *) buf;
    if (n < 0 || n >= sp[0])
	goto bad;
    i1 = sp[n + 1];
    i2 = PBLKSIZ;
    if (n > 0)
	i2 = sp[n + 1 - 1];
    i3 = sp[sp[0] + 1 - 1];
    if (i2 > i1)
	while (i1 > i3) {
	    i1--;
	    i2--;
	    buf[i2] = buf[i1];
	    buf[i1] = 0;
	}
    i2 -= i1;
    for (i1 = n + 1; i1 < sp[0]; i1++)
	sp[i1 + 1 - 1] = sp[i1 + 1] + i2;
    sp[0]--;
    sp[sp[0] + 1] = 0;
    return 0;

bad: 
    return -1;
}

static
additem (buf, item)
char    buf[PBLKSIZ];
datum item;
{
    register short *sp;
    register char *p;
    register    i1,
                i2;

    sp = (short *) buf;
    i1 = PBLKSIZ;
    if (sp[0] > 0)
	i1 = sp[sp[0] + 1 - 1];
    i1 -= item.dsize + 2*sizeof(long);
    i2 = (sp[0] + 2) * sizeof (short);
    if (i1 <= i2)
	return (-1);
    sp[sp[0] + 1] = i1;
    p = &buf[i1];
#ifdef vax
    * ((long *) p) = item.val1;
    p += sizeof(long);
    * ((long *) p) = item.val2;
    p += sizeof(long);
#else
    {
	register t = item.val1;
	*p++ = t & 255;
	*p++ = (t >> 8) & 255;
	*p++ = (t >> 16) & 255;
	*p++ = (t >> 24) & 255;
	t = item.val2;
	*p++ = t & 255;
	*p++ = (t >> 8) & 255;
	*p++ = (t >> 16) & 255;
	*p++ = (t >> 24) & 255;
    }
#endif
    for (i2 = 0; i2 < item.dsize; i2++) {
	*p++ = item.dptr[i2];
    }
    sp[0]++;
    return (sp[0] - 1);
}

static
chkblk (buf)
char    buf[PBLKSIZ];
{
    register short *sp;
    register    t,
                i;

    sp = (short *) buf;
    t = PBLKSIZ;
    for (i = 0; i < sp[0]; i++) {
	if (sp[i + 1] > t)
	    goto bad;
	t = sp[i + 1];
    }
    if (t < (sp[0] + 1) * sizeof (short))
	goto bad;
    return 0;

bad: 
    clrbuf (buf, PBLKSIZ);
    return -1;
}

put_db (key, keylen, content, contentlen, db)
register database *db;
char   *key,
       *content; {
    datum keyd, value;
    keyd.dptr = key;
    keyd.dsize = keylen;
    value = fetch (keyd, db);
    keyd.val2 = contentlen;
    setup_db (db);
    keyd.val1 = value.dptr && value.val2 >= contentlen
	? lseek (db -> datf, value.val1, 0)
	: lseek (db -> datf, 0, 2);
    if (store (keyd, db) < 0)
	return -1;
    write (db -> datf, content, contentlen);
    return 0;
}

static char *DefaultSpacefunc (n) {
    static char *space;
    static  spacelen;
    if (spacelen >= n && space)
	return space;
    spacelen = spacelen * 3 / 2;
    if (n + 100 > spacelen)
	spacelen = n + 100;
    if (space)
	free (space);
    space = (char *) malloc (spacelen);
    return space;
}

get_db (key, keylen, content, contentlen, spacefunc, db)
char *key;
int keylen;
char **content;
int *contentlen;
char *(*spacefunc)();
register database *db;
{
    datum value;
    if (spacefunc == 0)
	spacefunc = DefaultSpacefunc;
    value.dptr = key;
    value.dsize = keylen;
    value = fetch (value, db);
    if (value.dptr == 0)
	return - 1;
    if (content==0 || contentlen==0) return 1;
    *contentlen = value.val2;
    if ((*content = (*spacefunc) (value.val2)) == 0)
	return - 1;
    setup_db (db);
    lseek (db -> datf, value.val1, 0);
    return read (db -> datf, *content, *contentlen) == *contentlen ? 0 : -1;
}
options.c       508005727   1094  1000  100644  19440     `
/* A random assortment of commands: help facilities, macros, key bindings
   and package loading. */

/*		Copyright (c) 1981,1980 James Gosling		*/

/* Modified DJH 7-Dec-80	Added way to turn off automatic help
				window on command-completion errors */

/* Modified 8-Sept-81 Jeffrey Mogul (JCM) at Stanford
 *	- if we can't load "filename", try loading "filename.ml"
 */

#include "buffer.h"
#include "window.h"
#include "keyboard.h"
#include "config.h"
#include "macros.h"
#include "display.h"
#include "mlisp.h"
#include <ctype.h>

static
System(){
    register i = 0;
    register char *nd = getstr(": system-call ");

    if (!(nd && *nd)) nd = "cli";
    RstDsp();
    MLvalue -> exp_type = IsInteger;
    MLvalue -> exp_int = system(nd);
    InitDsp();
    return 0;
}

static
ChangeDirectory () {
    register char  *nd = getstr (": change-directory ");
    if (nd == 0)
	return 0;
    if (chdirg (nd) < 0)
	error ("Can't change to directory %s", nd);
    return 0;
}

static  Load () {
    ExecuteMLispFile (getstr (": load "), 0);
    return 0;
}

LoadFile(fn)
register char *fn; {
    register FILE *oldfd;
    struct ProgNode *oldExec = CurExec;
    char   *oldMem;
    register rv = 0;
    char    fnb[MaxPathNameLen];
    char    Xfn[MaxPathNameLen];

    if(fn==0) return rv;
    oldfd = InputFD;
    oldMem = MemPtr;
    if (fn == 0)
	return rv;
    if ((InputFD = fopenp (LoadSearchPath, fn, fnb, "r")) == NULL){
	/* couldn't open fn; let's try fn.ml */
	strcpy(Xfn,fn);
	strcat(Xfn,".ml");
	InputFD = fopenp (LoadSearchPath, Xfn, fnb, "r");
    }

    if (InputFD == NULL) {
    	/* still null?  Guess file isn't there */
	error ("Can't read %s",fn);
	rv++;
    }
    else {
	MemPtr = 0;
	CurExec = 0;
	ProcessKeys ();
	fclose (InputFD);
    }
    InputFD = oldfd;
    CurExec = oldExec;
    MemPtr = oldMem;
    return rv;
}

/* Given a sequence of keystrokes (at "keys" for "len" characters) return a
   printable representation of them -- with ESC's for escapes, and similar
   rot */
char   *KeyToStr (keys, len)
register char *keys;
register    len; {
    static char buf[30];
    register char  *p = buf;
    if (keys == 0 || len == 0)
	return "[Bogus keys]";
    while (--len >= 0) {
	if (p > &buf[sizeof buf - 5]) return ("[long key sequence]");
	if (*keys == 033) {
	    *p++ = 'E';
	    *p++ = 'S';
	    *p++ = 'C';
	}
	else
	    if (*keys < 040 || *keys == 0177) {
		*p++ = '^';
		*p++ = *keys == 0177 ? '?' : *keys | 0100;
	    }
	    else
		*p++ = *keys;
	keys++;
	if (len > 0)
	    *p++ = '-';
    }
    *p++ = '\0';
    return buf;
}

static
DescribeKey () {
    register    char key = *getkey (CurrentGlobalMap, ": describe-key ");
    register struct BoundName  **p;
    register char *WhereBound = "globally";
    if (key == 0 || err)
	return 0;
    p = LookupKeys (bf_mode.md_keys, MLvalue -> exp_v.v_string, MLvalue -> exp_int);
    if (p && !*p) p = 0;
    if (p)
	WhereBound = "locally";
    else
	p = LookupKeys (CurrentGlobalMap, MLvalue -> exp_v.v_string, MLvalue -> exp_int);
    if (p == 0 || *p == 0)
	message ("%s isn't bound to anything",
		 KeyToStr (MLvalue -> exp_v.v_string, MLvalue -> exp_int));
    else
	message ("%s is %s bound to the %s called \"%s\"",
		KeyToStr (MLvalue -> exp_v.v_string, MLvalue -> exp_int),
		WhereBound,
		(*p) -> b_binding == MacroBound ?	"macro" :
		(*p) -> b_binding == AutoLoadBound ?	"autoloaded function" :
		(*p) -> b_binding == MLispBound ?	"MLisp function" :
		(*p) -> b_binding == KeyBound ?		"keymap" :
							"wired procedure",
		(*p) -> b_name);
    VoidResult ();
    return 0;
}

static
LocalBindingOf () {
    register char   key = *getkey (CurrentGlobalMap, ": local-binding-of ");
    register struct BoundName **p;
    if (key == 0 || err)
	return 0;
    p = LookupKeys (bf_mode.md_keys, MLvalue -> exp_v.v_string,
		    MLvalue -> exp_int);
    MLvalue -> exp_type = IsString;
    MLvalue -> exp_v.v_string = p == 0 || *p == 0 ? "nothing" : (*p) -> b_name;
    MLvalue -> exp_release = 0;
    MLvalue -> exp_int = strlen (MLvalue -> exp_v.v_string);
    return 0;
}

static
GlobalBindingOf () {
    register char   key = *getkey (CurrentGlobalMap, ": global-binding-of ");
    register struct BoundName **p;
    if (key == 0 || err)
	return 0;
    p = LookupKeys (CurrentGlobalMap, MLvalue -> exp_v.v_string,
		     MLvalue -> exp_int);
    MLvalue -> exp_type = IsString;
    MLvalue -> exp_v.v_string = p == 0 || *p == 0 ? "nothing" : (*p) -> b_name;
    MLvalue -> exp_release = 0;
    MLvalue -> exp_int = strlen (MLvalue -> exp_v.v_string);
    return 0;
}

/* Recursively scan a keymap tree.  It gets passed a pointer to a map and a
   function.  For each BoundName the function is called with these
   parameters: the BoundName, the keystrokes leading to it (as a char * and
   an int) and a count of the number of following keys that are bound to the
   same BoundName.  A run of equal BoundNames in a keymap is only passed to
   the procedure once. */
ScanMap (map, proc, FoldCase)
register struct keymap *map;
int (*proc) ();
{
    char    keys[100];
    if (map)
	ScanMapInner (map, proc, 0, keys, 0, FoldCase);
}

ScanMapInner (map, proc, history, keys, len, FoldCase)
register struct keymap *map;
int (*proc)();
struct hist *history;
char *keys;
{
    struct hist {		/* To catch recursive invocations we
				   thread through the stack a list of
				   the keymaps that we've seen. */
	struct hist *prev;
	struct keymap  *this;
    }           hist;
    register struct BoundName  *b;
    register c;
    int c2;
    hist.prev = history;
    hist.this = map;
    for (c = 0; c <= 0177; c = c2) {
	c2 = c + 1;
	if ((b = map -> k_binding[c])
		&& (!FoldCase || !isupper(c)
		    || b != map -> k_binding[tolower(c)])) {
	    keys[len] = c;
	    for (; c2 <= 0177 && map -> k_binding[c2] == b; c2++);
	    (*proc) (b, keys, len+1, c2 - c);
	    if (b -> b_binding == KeyBound && b -> b_bound.b_keymap) {
		register struct hist   *h;
		for (h = history; h && h -> this != map; h = h -> prev);
		if (!h)
		    ScanMapInner (b -> b_bound.b_keymap, proc, &hist, keys, len + 1, FoldCase);
	    }
	}
    }
}

/* Helper function for DescribeBindings -- inserts one line of info for the
   given boundname */
static
Describe1 (b, keys, len, range)
register struct BoundName *b;
char *keys;
{
    register indent;
    char *s = KeyToStr (keys, len);
    indent = strlen(s);
    InsCStr (s, indent);
    if (range>1) {
	register k;
	keys[len-1] += range-1;
	InsCStr ("..", 2);
	s = KeyToStr (keys, len);
	k = strlen (s);
	InsCStr (s, k);
	indent += k + 2;
	keys[len-1] -= range-1;
    }
    InsCStr ("                    ", indent<16 ? 16-indent : 1);
    InsStr (b->b_name);
    InsCStr ("\n", 1);
}

static
DescribeBindings () {
    register struct keymap *LocalMap = bf_mode.md_keys;
    SetBfn ("Help");
    EraseBf (bf_cur);
    WindowOn (bf_cur);
    InsStr ("Global Bindings:\n\
key		binding\n---		-------\n");
    ScanMap (CurrentGlobalMap, Describe1, 1);
    if (LocalMap) {
	InsStr ("\nLocal Bindings:\n");
	ScanMap (LocalMap, Describe1, 0);
    }
    BeginningOfFile ();
    bf_cur -> b_mode.md_NeedsCheckpointing = 0;
    bf_modified = 0;
    return 0;
}

static
DefineKeyboardMacro () {
    register char  *name;
    if (Remembering) {
	error ("Not allowed to define a macro while remembering.");
	return 0;
    }
    if (MemUsed <= 0) {
	error ("No keyboard macro defined.");
	return 0;
    }
    name = getnbstr (": define-keyboard-macro ");
    if (name == 0)
	return 0;
    DefMac (name, KeyMem, 0);
    MemUsed = 0;
    return 0;
}

static
DefineStringMacro () {
    char    name[200],
           *p;
    if (Remembering) {
	error ("Not allowed to define a macro while remembering.");
	return 0;
    }
    p = getnbstr (": define-string-macro name: ");
    if (p == 0)
	return 0;
    strcpy (name, p);
    p = getstr (": define-string-macro name: %s body: ", name);
    if (p == 0)
	return 0;
    DefMac (name, p, 0);
    return 0;
}

static
BindToKey () {
    register    i = getword (MacNames, ": bind-to-key name: ");
    register    char *c;
    struct keymap *p;
    if (i < 0)
	return 0;
    c = getkey (CurrentGlobalMap, ": bind-to-key name: %s key: ", MacNames[i]);
    if (c == 0)
	return 0;
    p = CurrentGlobalMap;
    PerformBind (&p, MacBodies[i]);
    return 0;
}

static
RemoveBinding () {
    register char c = *getkey (CurrentGlobalMap, ": remove-binding ");
    register struct BoundName **b;
    if (!err) {
	b = LookupKeys (CurrentGlobalMap, MLvalue -> exp_v.v_string, MLvalue -> exp_int);
	if (b)
	    *b = 0;
    }
    VoidResult ();
    return 0;
}

static
LocalBindToKey () {
    register    i = getword (MacNames, ": local-bind-to-key name: ");
    register    char *c;
    if (i < 0)
	return 0;
    InitializeLocalMap ();
    c = getkey (bf_mode.md_keys, ": local-bind-to-key name: %s key: ", MacNames[i]);
    if (c == 0)
	return 0;
    PerformBind (&bf_mode.md_keys,MacBodies[i]);
    return 0;
}

UseGlobalMap () {
    register    i = getword (MacNames, ": use-global-map ");
    if (i < 0)
	return 0;
    if (MacBodies[i] -> b_binding != KeyBound)
	error ("%s isn't a keymap.", MacNames[i]);
    else
	CurrentGlobalMap = MacBodies[i] -> b_bound.b_keymap;
    NextGlobalKeymap = NextLocalKeymap = 0;
    return 0;
}

UseLocalMap () {
    register    i = getword (MacNames, ": use-local-map ");
    if (i < 0)
	return 0;
    if (MacBodies[i] -> b_binding != KeyBound)
	error ("%s isn't a keymap.", MacNames[i]);
    else
	bf_mode.md_keys = bf_cur->b_mode.md_keys =
		MacBodies[i] -> b_bound.b_keymap;
    NextGlobalKeymap = NextLocalKeymap = 0;
    return 0;
}

/* The following procedure is a horrible compatibility hack.  It
   is called to ensure that the local map exists and that the ESC and ^X
   slots in it are non-empty.  If they are empty, then they are forced to be
   bound to keymaps. */
InitializeLocalMap () {
    if (bf_mode.md_keys == 0 || bf_mode.md_keys -> k_binding[033] == 0
	    || bf_mode.md_keys -> k_binding[030] == 0) {
	char    HorribleHack[2];
	HorribleHack[1] = 0;
	ReleaseExpr (MLvalue);
	HorribleHack[0] = 033;
	MLvalue -> exp_v.v_string = HorribleHack;
	MLvalue -> exp_int = 2;
	if (bf_mode.md_keys == 0 || bf_mode.md_keys -> k_binding[033] == 0)
	    PerformBind (&bf_mode.md_keys, (struct BoundName *) 0);
	HorribleHack[0] = 030;
	MLvalue -> exp_v.v_string = HorribleHack;
	MLvalue -> exp_int = 2;
	if (bf_mode.md_keys == 0 || bf_mode.md_keys -> k_binding[030] == 0)
	    PerformBind (&bf_mode.md_keys, (struct BoundName *) 0);
    }
}

PerformBind (tbl, name)
struct keymap **tbl;
struct BoundName *name;
{
    register char  *p = MLvalue -> exp_v.v_string;
    register    level = MLvalue -> exp_int;

    while (--level >= 0) {
	if (*tbl == 0) {
	    register int    n;
	    *tbl = (struct keymap  *) malloc (sizeof **tbl);
	    if (tbl == &bf_mode.md_keys)
		bf_cur -> b_mode.md_keys = bf_mode.md_keys;
	    for (n = 0; n < 0200; n++)
		(*tbl) -> k_binding[n] = 0;
	}
	if (level>0 && ((*tbl)->k_binding[*p]==0
			|| (*tbl)->k_binding[*p]->b_binding != KeyBound)) {
	    register struct BoundName *nm =
		(struct BoundName *) malloc (sizeof (struct BoundName));
	    nm -> b_name = "BOGUS!";
	    nm -> b_binding = KeyBound;
	    nm -> b_bound.b_keymap = 0;
	    (*tbl) -> k_binding[*p] = nm;
	}
	if (level>0) tbl = &(*tbl)->k_binding[*p++]->b_bound.b_keymap;
    }
    (*tbl) -> k_binding[*p] = name;
    VoidResult ();
}

static
RemoveLocalBinding () {
    register char   c;
    register struct BoundName **b;
    InitializeLocalMap ();
    c = *getkey (bf_mode.md_keys, ": remove-local-binding ");
    if (!err) {
	b = LookupKeys (bf_mode.md_keys, MLvalue -> exp_v.v_string, MLvalue -> exp_int);
	if (b)
	    *b = 0;
    }
    VoidResult ();
    return 0;
}

static
RemoveAllLocalBindings () {
    register c;
    register struct keymap *m;
    if (m = bf_mode.md_keys)
	for (c = 0; c < 0200; c++)
	    m -> k_binding[c] = 0;
    return 0;
}


ExecuteExtendedCommand () {
    register    ind;
    register struct BoundName  *p;
    register    rv = 0;
    ind = getword (MacNames, ": ");
    if (ind < 0)
	return 0;
    p = MacBodies[ind];
    rv = ExecuteBound (p);
    if (interactive && !err && MLvalue -> exp_type != IsVoid)
	switch (MLvalue -> exp_type) {
	    default: 
		error ("MLisp function returned a bizarre result!");
		break;
	    case IsInteger: 
		message ("MLisp function returned %d",
			 MLvalue -> exp_int);
		break;
	    case IsString: 
		message ("MLisp function returned \"%s\"",
			 MLvalue -> exp_v.v_string);
		break;
	    case IsMarker:
	    	{
		    register struct marker *m = MLvalue -> exp_v.v_marker;
		    if (m) message ("MLisp function returned (\"%s\", %d)",
		    		m -> m_buf -> b_name, MarkerValue (m));
		}
		break;
	}
    return rv;
}

static
FunctionType () {
    register i;
    register enum BindingKind b;
    ReleaseExpr (MLvalue);
    i = getword (MacNames, ": function-type ");
    if (i < 0) return 0;
    b = MacBodies[i] -> b_binding;

    /* Begin bogus function workaround */
    if (b == MLispBound && MacBodies[i] -> b_bound.b_prog == 0)
	error ("%s has not been defined yet", MacNames[i]);
    /* End bogus function workaround */
    else {
	MLvalue -> exp_type = IsString;
	MLvalue -> exp_release = 0;
	MLvalue -> exp_v.v_string = b==MacroBound ?	"macro" :
				    b==AutoLoadBound ?	"autoloaded function" :
				    b==MLispBound ?	"MLisp function" :
				    b==KeyBound ?	"keymap" :
				    			"wired procedure";
	MLvalue -> exp_int = strlen (MLvalue -> exp_v.v_string);
    }
    return 0;
}

DefineKeymap () {
    register char  *mapname = getnbstr (": define-keymap ");
    register struct keymap *m;
    register i;
    if (mapname == 0)
	return 0;
    DefMac (mapname, m = (struct keymap *) malloc(sizeof (struct keymap)),-2);
    for (i = 0; i<=0177; i++) m->k_binding[i] = 0;
    return 0;
}

/* 10 Jul 1983: Changed definition of autoload */
Autoload () {
    return DefineAutoload ("");
}

AutoloadIfNecessary () {
    return DefineAutoload ("-if-necessary");
}

/* The difference between autoload and autoload-if-necessary is that 
   autoload will twiddle the definition if it is currently "autoload",
   whereas autoload-if-necessary will not. This way MLisp packages
   can default to obtaining other MLisp routines from other packages,
   but if the user wishes, he may redefine them. */
DefineAutoload (type) char *type; {
    register char   *name;
    register struct BoundName *p;
    register int    index;
    char	    combuf[500];

    name = getnbstr (": autoload%s procedure ", type);
    if (name == 0)
	return 0;
    strcpy (combuf, name);
    index = FindMac (name);
    if (index >= 0) {
    	p = MacBodies[index];
	if (p-> b_binding == MLispBound && p -> b_bound.b_prog == 0)
	    p = 0;	/* Not really defined (bogus function workaround) */
	if (p && *type) /* was -if-necessary but not necessary */
	    return 0;
    }
    else
        p = 0;
    name = getnbstr (": autoload%s procedure %s from file ", type, combuf);
    if (name == 0)
	return 0;
    /* If it isn't already defined, or if it's autoloaded and it's not
       being autoload-if-necessary'd, then define it */
    if (p==0 || (p->b_binding==AutoLoadBound && *type==0))
    	DefMac (combuf, name, -1);
    return 0;
}

ExecuteBound (p)		/* execute whatever is bound to p */
register struct BoundName *p;
{
    register    rv = 0;
    register    larg;
    if (ArgState == NoArg)
	arg = 1;
    if (ArgState == PreparedArg)
	ArgState = HaveArg;
    larg = arg;
    ReleaseExpr (MLvalue);
    MLvalue = &GlobalValue;
    GlobalValue.exp_type = IsVoid;
    GlobalValue.exp_refcnt = 99;
    if (p)
	switch (p -> b_binding) {
	    case MacroBound: 
		{
		    struct ProgNode *LCurExec = CurExec;
		    CurExec = 0;
		    do
			ExecStr (p -> b_bound.b_body);
		    while (!err && --larg > 0);
		    CurExec = LCurExec;
		}
		break;
	    case MLispBound: 
		{
		    struct ExecutionStack   parent;
		    parent = ExecutionRoot;
		    ExecutionRoot.PrefixArgument = larg;
		    ExecutionRoot.PrefixArgumentProvided = ArgState != NoArg;
		    ExecutionRoot.CurExec = CurExec;
		    ExecutionRoot.DynParent = &parent;
		    ArgState = NoArg;
		    rv = ExecProg (p -> b_bound.b_prog);
		    ExecutionRoot = parent;
		    break;
		}
	    case AutoLoadBound: 
		{
		    int     larg = arg;
		    enum ArgStates lstate = ArgState;
		    arg = 0;
		    ArgState = NoArg;
		    ExecuteMLispFile (p -> b_bound.b_body, 0);
		    if (!err)
			if (p -> b_binding == AutoLoadBound)
			    error ("%s was supposed to be defined by autoloading %s, but it wasn't.",
				    p -> b_name, p -> b_bound.b_body);
			else {
			    arg = larg;
			    ArgState = lstate;
			    rv = ExecuteBound (p);
			}
		    break;
		}
	    case KeyBound: 
		NextLocalKeymap = p -> b_bound.b_keymap;
		break;
	    case ProcBound: 
		rv = (*p -> b_bound.b_proc) (-1);
		if (ArgState != PreparedArg)
		    LastProc = *p -> b_bound.b_proc;
		if (dot < FirstCharacter)
		    SetDot (FirstCharacter);
		if (dot > NumCharacters)
		    SetDot (NumCharacters + 1);
	}
    if (p -> b_binding != KeyBound && ArgState != PreparedArg) {
	ArgState = NoArg;
	arg = 1;
    }
    return rv;
}

/* Dump a stack trace to the stack trace buffer -- handles recursive calls
   (eg. from error()) */
DumpStackTrace () {
    register struct buffer *old = bf_cur;
    register struct ExecutionStack *p;
    register SetWindow = wn_cur->w_buf == bf_cur;
    static DumpDepth;
    DumpDepth++;
    if (DumpDepth>1) return 0;
    SetBfn ("Stack trace");
    WindowOn (bf_cur);
    WidenRegion ();
    EraseBf (bf_cur);
    if (err) {
	InsCStr ("Message:   ", 11);
	InsStr (MiniBuf);
	InsCStr ("\n", 1);
    }
    InsCStr ("Executing: ", 11);
    PrintExpr (CurExec, 1);
    InsCStr ("\n", 1);
    for (p = &ExecutionRoot; p->DynParent && DumpDepth<=1; p = p->DynParent) {
	PrintExpr (p->CurExec, 1);
	InsCStr ("\n", 1);
    }
    InsStr (DumpDepth>1 ? "** error during stack trace **\n"
			: "--- bottom of stack ---\n");
    SetDot (1);
    DumpDepth = 0;
    bf_cur -> b_mode.md_NeedsCheckpointing = 0;
    bf_modified = 0;
    SetBfp (old);
    if (SetWindow) WindowOn (bf_cur);
    return 0;
}

InitOpt () {
#ifdef DumpableEmacs
    if (!Once)
#endif
    {
	setkey (ESCmap, ('x'), ExecuteExtendedCommand, 
			       "execute-extended-command");
	defproc (Load, "load");
	defproc (Autoload, "autoload");
	defproc (AutoloadIfNecessary, "autoload-if-necessary");
	defproc (LocalBindingOf, "local-binding-of");
	defproc (GlobalBindingOf, "global-binding-of");
	defproc (ChangeDirectory, "change-directory");
        defproc (System, "system-call");
	defproc (DescribeKey, "describe-key");
	defproc (DefineKeyboardMacro, "define-keyboard-macro");
	defproc (DefineStringMacro, "define-string-macro");
	defproc (BindToKey, "bind-to-key");
	defproc (LocalBindToKey, "local-bind-to-key");
	defproc (RemoveBinding, "remove-binding");
	defproc (RemoveLocalBinding, "remove-local-binding");
	defproc (RemoveAllLocalBindings, "remove-all-local-bindings");
	defproc (DescribeBindings, "describe-bindings");
	defproc (DumpStackTrace, "dump-stack-trace");
	defproc (DefineKeymap, "define-keymap");
	defproc (UseLocalMap, "use-local-map");
	defproc (UseGlobalMap, "use-global-map");
	DefIntVar ("prefix-argument", &ExecutionRoot.PrefixArgument);
	DefIntVar ("prefix-argument-provided",
		    &ExecutionRoot.PrefixArgumentProvided);
	defproc (FunctionType, "function-type");
    }
}
search.c        508005728   1094  1000  100644  20623     `
/* string search routines */

/*		Copyright (c) 1981,1980 James Gosling		*/

/* Modified Aug. 12, 1981 by Tom London to include regular expressions
   as in ed.  RE stuff hacked over by jag to correct a few major problems,
   mainly dealing with searching within the buffer rather than copying
   each line to a separate array.  Newlines can now appear in RE's */

#include "buffer.h"
#include "window.h"
#include "keyboard.h"
#include "mlisp.h"
#include "syntax.h"
#include "search.h"
#include <ctype.h>

/* meta characters in the "compiled" form of a regular expression */
#define	CBRA	2		/* \( -- begin bracket */
#define	CCHR	4		/* a vanilla character */
#define	CDOT	6		/* . -- match anything except a newline */
#define	CCL	8		/* [...] -- character class */
#define	NCCL	10		/* [^...] -- negated character class */
#define	CDOL	12		/* $ -- matches the end of a line */
#define	CEOF	14		/* The end of the pattern */
#define	CKET	16		/* \) -- close bracket */
#define	CBACK	18		/* \N -- backreference to the Nth bracketed
				   string */
#define CIRC	20		/* ^ matches the beginning of a line */
#define BBUF	22		/* beginning of buffer \` */
#define EBUF	24		/* end of buffer \' */
#define BDOT	26		/* matches before dot \< */
#define EDOT	28		/* matches at dot \= */
#define ADOT	30		/* matches after dot \> */
#define WORD	32		/* matches word character \w */
#define NWORD	34		/* matches non-word characer \W */
#define WBOUND	36		/* matches word boundary \b */
#define NWBOUND	38		/* matches non-(word boundary) \B */

#define	STAR	01		/* * -- Kleene star, repeats the previous
				   REas many times as possible; the value
				   ORs with the other operator types */


typedef char    TranslateTable[0400];

static  TranslateTable
        StandardTRT,		/* the identity TRT */
        CaseFoldTRT;		/* folds upper to lower case */
/*      WordTRT;		/* folds upper to lower case and
				   punctuation to blanks */

static  ReplaceCase;		/* If true then replace and
				   query-replace will modify the case
				   conventions of the new string to
				   match those of the old. */
int	NumReplaced;		/* The number of replacements done */

/* search for the n'th occurrence of string s in the current buffer,
   starting at dot, leaving dot at the end (if forward) or beginning
   (if reverse) of the found string.  returns true or false
   depending on whether or not the string was found */
search (s, n, dot, RE)
char   *s; {
    register    pos = dot;
    register    matl;

    search_globals.TRT = bf_mode.md_FoldCase ? CaseFoldTRT : StandardTRT;
    if (s == 0)
	return -1;
    compile (s, RE);
    while (!err && n)
	if (n < 0) {
	    if (pos <= FirstCharacter)
		return 0;
	    if ((matl = execute (0, pos - 1)) < 0)
		return 0;
	    ++n;
	    pos = search_globals.loc1;
	}
	else {
	    if (pos > NumCharacters)
		return 0;
	    if ((matl = execute (1, pos)) < 0)
		return 0;
	    --n;
	    pos = search_globals.loc1 + matl;
	}
    return err ? -1 : pos;
}

static
LookingAt () {			/* (looking-at "str") is true iff we're
				   currently looking at the given RE */
    register char  *s = getstr (": looking-at ");
    register char **alt = search_globals.alternatives;

    if (s == 0)
	return 0;
    search_globals.TRT = bf_mode.md_FoldCase ? CaseFoldTRT : StandardTRT;
    compile (s, 1);
    MLvalue -> exp_int = 0;
    while (*alt && !err)
	if (MLvalue -> exp_int = advance (dot, *alt++))
	    break;
    MLvalue -> exp_type = IsInteger;
    search_globals.loc1 = dot;
    return 0;
}

SearchReverse () {
    register    np;
    if (arg <= 0)
	arg = 1;
    np = search (getstr ("Reverse search for: "), -arg, dot, 0);
    if (np == 0)
	error ("Can't find it");
    else
	if (np > 0)
	    SetDot (np);
    return 0;
}

SearchForward () {
    register    np;
    if (arg <= 0)
	arg = 1;
    np = search (getstr ("Search for: "), arg, dot, 0);
    if (np == 0)
	error ("Can't find it");
    else
	if (np > 0)
	    SetDot (np);
    return 0;
}

static
ReplaceString () {
    PerformReplace (0, 0);
    return 0;
}

static
QueryReplaceString () {
    PerformReplace (1, 0);
    return 0;
}

ReSearchReverse () {
    register    np;
    if (arg <= 0)
	arg = 1;
    np = search (getstr ("Reverse RE search for: "), -arg, dot, 1);
    if (np == 0)
	error ("Can't find it");
    else
	if (np > 0)
	    SetDot (np);
    return 0;
}

ReSearchForward () {
    register    np;
    if (arg <= 0)
	arg = 1;
    np = search (getstr ("RE Search for: "), arg, dot, 1);
    if (np == 0)
	error ("Can't find it");
    else
	if (np > 0)
	    SetDot (np);
    return 0;
}

static
ReReplaceString () {
    PerformReplace (0, 1);
    return 0;
}

static
ReQueryReplaceString () {
    PerformReplace (1, 1);
    return 0;
}

static
PerformReplace (query, RE) {	/* perform either a query replace or a
				   normal replace */
    register char  *old = getstr ("Old %s: ", RE ? "pattern" : "string");
    char  *TempNew;
    char new[1000];
    int     np,
            comma = 0;
    register char   c;
    int     olddot = dot;
    struct ProgNode *OldExec = CurExec;

    if (old == 0 || (compile (old, RE), err)
	    || (TempNew = getstr ("New string: ")) == 0)
	return 0;
    strcpyn (new, TempNew, sizeof new - 1);
    new[sizeof new - 1] = 0;
    NumReplaced = 0;
    CurExec = 0;
    if (query)
	message ("Query-Replace mode");
    do {
	np = search ("", 1, dot, RE);
	if (np <= 0)
	    break;
	SetDot (np);
	comma = 0;
	do {
	    switch (c = query ? GetChar () : ' ') {
		case ' ': 
		case '!': 
		case '.': 
		case ',': {
			enum {
			    do_nothing, UPPER, First, FirstAll
			} action = do_nothing;
			if (!comma) {
			    if (ReplaceCase) {
				register    i;
				int     BegOfStr,
				        BegOfWord;
				register char   lc;
				BegOfStr = 1;
				i = search_globals.loc1;
				BegOfWord = i <= FirstCharacter
						|| !isalpha (CharAt (i - 1));
				while (i < search_globals.loc2) {
				    if (isalpha (lc = CharAt (i))) {
					if (isupper (lc)) {
					    if (BegOfStr)
						action = First;
					    else
						if (BegOfWord && action != UPPER)
						    action = FirstAll;
						else
						    action = UPPER;
					}
					else
					    if (action == UPPER || action == FirstAll && BegOfWord) {
						action = do_nothing;
						break;
					    } BegOfStr = 0;
					BegOfWord = 0;
				    }
				    else
					BegOfWord = 1;
				    i++;
				}
			    }
			    {
				int     BegOfStr,
				        BegOfWord;
				register char  *p;
				register unsigned char  lc;
				unsigned char   prefix = 0;
				BegOfStr = 1;
				BegOfWord = dot <= FirstCharacter
					|| !isalpha (CharAt (dot - 1));
				for (p = new; lc = *p++;) {
				    lc |= prefix;
				    if (action != do_nothing && prefix == 0
				    		&& isalpha (lc)) {
					if (islower (lc)
						&& (action == UPPER
						    || action == FirstAll
						    && BegOfWord
						    || action == First
						    && BegOfStr))
					    lc = toupper (lc);
					BegOfWord = 0;
					BegOfStr = 0;
				    }
				    else
					BegOfWord = 1;
				    prefix = 0;
				    if (lc == '\\' && RE)
					prefix = 0200;
				    else
					if (lc == '&' && RE)
					    place (search_globals.loc1, search_globals.loc2);
					else
					    if (lc >= ('1' | 0200) && lc < ((search_globals.nbra + '1') | 0200))
						place (search_globals.braslist[lc - ('1' | 0200)],
							search_globals.braelist[lc - ('1' | 0200)]);
					    else {
						InsertAt (dot, (int) lc & 0177);
						DotRight (1);
					    }
				}
			    }
			    if (search_globals.loc1 == search_globals.loc2)
				DotRight (1);
			    else {
				DotLeft (search_globals.loc2 - search_globals.loc1);
				DelBack (search_globals.loc2, search_globals.loc2 - search_globals.loc1);
			    }
			    NumReplaced++;
			} if (c == '!')
			    query = 0;
			if (c == '.')
			    c = Ctl ('G');
			break;
		    }
		case '\033':
		    c = Ctl ('G');
		case 'n': 
		case '\177':
		case Ctl ('G'): 
		    break;
		case 'r':
		    {	struct search_globals lglobals;
			struct marker *m = NewMark ();
			lglobals = search_globals;
			SetMark (m, bf_cur, search_globals.loc1);
			message ("Type ^C to resume query-replace");
			CurExec = OldExec;
			RecursiveEdit ();
			SetDot (ToMark (m));
			DestMark (m);
			WindowOn (bf_cur);
			CurExec = 0;
			message ("Continuing with query-replace...");
			search_globals = lglobals;
			break;
		    }
		default: 
		    message ("Options: ' ' ','=>change; 'n'=>don't; '.'=>change, quit; '^G'=>quit");
		    c = '?';
		    break;
	    }
	    if (c == ',')
		comma++;
	} while (c == '?' || c == ',');
    } while (c != Ctl ('G'));
    if (NumReplaced)
	message ("Replaced %d occurrences", NumReplaced);
    else
	error ("No replacements done ");
    SetDot (olddot);
    VoidResult ();
    return 0;
}

/* put dot and mark around the region matched by the n'th parenthesised
   expression from the last search (n=0 => the whole thing) */
RegionAroundMatch () {
    register    n = getnum (": region-around-match ");
    register    lo,
                hi;
    if (n < 0 || n > search_globals.nbra)
	error (" Out-of-bounds argument to region-around-match ");
    if (err)
	return 0;
    if (n == 0)
	lo = search_globals.loc1, hi = search_globals.loc2;
    else
	lo = search_globals.braslist[n-1], hi = search_globals.braelist[n-1];
    SetDot (lo);
    SetMarkCommand ();
    SetDot (hi);
    return 0;
}

/* Quote a string to inactivate reg-expr chars */
Quote() {
    register char *p, *cp, *s = getstr(": quote ");
    register int size;

    if (s == 0)
	return 0;
    size = strlen(s);
    for (cp=s;
	*cp;
	cp++)
	if (*cp == '[' || *cp == ']' || *cp == '*' || *cp == '.' || *cp=='\\'
		|| (*cp == '^' && cp==s) || (*cp == '$' && *(cp+1) == 0))
	    size++;
    p = (char *) malloc((unsigned) size+1);
    for (cp=p; *s; )
	if (*s == '[' || *s == ']' || *s == '*' || *s == '.' || *s=='\\'
		|| (*s == '^' && cp==p) || (*s == '$' && *(s+1) == 0)) {
	    *cp++ = '\\';
	    *cp++ = *s++;
	}
	else
	    *cp++ = *s++;
    *cp = 0;
    ReleaseExpr (MLvalue);
    MLvalue -> exp_type = IsString;
    MLvalue -> exp_int = size;
    MLvalue -> exp_release = 1;
    MLvalue -> exp_v.v_string = p;
    return 0;
}

/* Compare two chars according to case-fold   APW 1/81 */
static
CharCompare () {
    register char  *trt;
    register    a = binsetup ();
    register    b = NumericArg (2);
    trt = search_globals.TRT = bf_mode.md_FoldCase ? CaseFoldTRT : StandardTRT;
    MLvalue -> exp_type = IsInteger;
    MLvalue -> exp_int = (trt[a] == trt[b]);
    return (0);
}

InitSrch () {			/* Initialize the search package, mostly just
				   sets up translation tables */
    register int    i;
#ifdef DumpableEmacs
    if (!Once)
#endif
    {
    	for (i = 0; i < 0400; i++) {
	    StandardTRT[i] = CaseFoldTRT[i] = i;
/*	    WordTRT[i] = ' '; */
        }
    	for (i = 'A'; i <= 'Z'; i++)
	    /* WordTRT[i + ('a' - 'A')] = WordTRT[i] = */ CaseFoldTRT[i] =
	    	i + ('a' - 'A');
/*      for (i = '0'; i <= '9'; i++)
	    WordTRT[i] = i; */
    	setkey (GlobalMap, (Ctl ('S')), SearchForward, "search-forward");
    	setkey (GlobalMap, (Ctl ('R')), SearchReverse, "search-reverse");
    	setkey (ESCmap, ('r'), ReplaceString, "replace-string");
    	setkey (ESCmap, ('q'), QueryReplaceString, "query-replace-string");
    	defproc (ReSearchForward, "re-search-forward");
    	defproc (ReSearchReverse, "re-search-reverse");
    	defproc (ReReplaceString, "re-replace-string");
    	defproc (ReQueryReplaceString, "re-query-replace-string");
    	defproc (LookingAt, "looking-at");
    	defproc (RegionAroundMatch, "region-around-match");
    	defproc (Quote, "quote");
    	defproc (CharCompare, "c=");
    	DefIntVar ("replace-case", &ReplaceCase);
    }
}

/* Compile the given regular expression into a [secret] internal format */
static
compile (strp, RE)
char   *strp; {
    register    c;
    register char  *ep;
    char   *lastep;
    char    bracket[NBRA],
           *bracketp;
    int     cclcnt;
    char **alt = search_globals.alternatives;

    ep = search_globals.expbuf;
    *alt++ = ep;
    bracketp = bracket;
    if (*strp == 0) {
	if (*ep == 0)
	    error ("null search string");
	return;
    }
    search_globals.nbra = 0;
    lastep = 0;
    for (;;) {
	if (ep >= &search_globals.expbuf[ESIZE])
	    goto cerror;
	c = *strp++;
	if (c == 0) {
	    if (bracketp != bracket)
		goto cerror;
	    *ep++ = CEOF;
	    *alt++ = 0;
	    return;
	}
	if (c != '*')
	    lastep = ep;
	if (!RE) {
	    *ep++ = CCHR;
	    *ep++ = c;
	}
	else
	    switch (c) {

		case '\\': 
		    switch (c = *strp++) {
		    case '(':
			if (search_globals.nbra >= NBRA)
			    goto cerror;
			*bracketp++ = search_globals.nbra;
			*ep++ = CBRA;
			*ep++ = search_globals.nbra++;
			break;
		    case '|':
			if (bracketp>bracket) goto cerror;	/* Alas! */
			*ep++ = CEOF;
			*alt++ = ep;
			break;
		    case ')':
			if (bracketp <= bracket)
			    goto cerror;
			*ep++ = CKET;
			*ep++ = *--bracketp;
			break;
		    case '<':
			*ep++ = BDOT;
			break;
		    case '=':
			*ep++ = EDOT;
			break;
		    case '>':
			*ep++ = ADOT;
			break;
		    case '`':
			*ep++ = BBUF;
			break;
		    case '\'':
			*ep++ = EBUF;
			break;
		    case 'w':
			*ep++ = WORD;
			break;
		    case 'W':
			*ep++ = NWORD;
			break;
		    case 'b':
			*ep++ = WBOUND;
			break;
		    case 'B':
			*ep++ = NWBOUND;
			break;
		    /* if (c >= '1' && c < '1' + NBRA) */
		    case '1': case '2': case '3': case '4': case '5':
		    case '6': case '7': case '8': case '9':
			*ep++ = CBACK;
			*ep++ = c - '1';
			break;
		    default:
			*ep++ = CCHR;
			if (c == '\0')
			    goto cerror;
			*ep++ = c;
			break;
		    }
		    break;
		case '.': 
		    *ep++ = CDOT;
		    continue;

		case '*': 
		    if (lastep == 0 || *lastep == CBRA || *lastep == CKET
			|| *lastep == CIRC || BBUF<=*lastep && *lastep<=ADOT
			|| (*lastep&STAR)|| *lastep>NWORD)
			goto defchar;
		    *lastep |= STAR;
		    continue;

		case '^':
		    if (ep != search_globals.expbuf && ep[-1] != CEOF)
			goto defchar;
		    *ep++ = CIRC;
		    continue;

		case '$': 
		    if (*strp != 0 && (*strp != '\\' || strp[1] != '|'))
			goto defchar;
		    *ep++ = CDOL;
		    continue;

		case '[': 
		    *ep++ = CCL;
		    *ep++ = 0;
		    cclcnt = 1;
		    if ((c = *strp++) == '^') {
			c = *strp++;
			ep[-2] = NCCL;
		    }
		    do {
			if (c == '\0')
			    goto cerror;
			if (c == '\\')
			    if ((c = *strp++) == 0)
			    	goto cerror;
			    else
			    	goto ccl_vanilla;
			if (c == '-' && ep[-1] != 0) {
			    if ((c = *strp++) == ']') {
				*ep++ = '-';
				cclcnt++;
				break;
			    }
			    while (ep[-1] < c) {
				/* Ridiculous!  This should be reflected
				   in the compiled form! */
				*ep = ep[-1] + 1;
				ep++;
				cclcnt++;
				if (ep >= &search_globals.expbuf[ESIZE])
				    goto cerror;
			    }
			}
ccl_vanilla:
			*ep++ = c;
			cclcnt++;
			if (ep >= &search_globals.expbuf[ESIZE])
			    goto cerror;
		    } while ((c = *strp++) != ']');
		    lastep[1] = cclcnt;
		    continue;

	    defchar: 
		default: 
		    *ep++ = CCHR;
		    *ep++ = c;
	    }
    }
cerror: 
    search_globals.expbuf[0] = 0;
    search_globals.nbra = 0;
    error ("Badly formed search string");
}

/* Check to see whether the most recently compile'd regular expression
   matches the string starting at addr in the buffer.
   The search match is performed in the current buffer.
   fflag is true iff we're doing a forward search. */
static
execute (fflag, addr) {
    register int    p1 = addr;
    register char  *trt = search_globals.TRT;
    register    c;
    int     incr = fflag ? 1 : -1;

    for (c = 0; c < NBRA; c++) {
	search_globals.braslist[c] = 0;
	search_globals.braelist[c] = 0;
    }
    if (addr == 0)
	return (-1);
    if (search_globals.expbuf[0] == CCHR && !search_globals.alternatives[1]) {
	c = trt[search_globals.expbuf[1]];	/* fast check for first character */
	do {
	    if (trt[CharAt (p1)] == c && advance (p1, search_globals.expbuf)) {
		search_globals.loc1 = p1;
		return (search_globals.loc2 - search_globals.loc1);
	    }
	    p1 += incr;
	} while (p1 <= NumCharacters && p1 >= FirstCharacter);
	return (-1);
    }
    else			/* regular algorithm */
	do {
	    register char **alt = search_globals.alternatives;
	    while (*alt)
		if (advance (p1, *alt++)) {
		    search_globals.loc1 = p1;
		    return (search_globals.loc2 - search_globals.loc1);
		}
	    p1 += incr;
	} while (p1 <= NumCharacters && p1 >= FirstCharacter);
    return (-1);
}

/* advance the match of the regular expression starting at ep along the
   string lp, simulates an NDFSA */
static
advance (lp, ep)
register char  *ep;
register lp; {
    register curlp;
    int     i;
    register char  *trt = search_globals.TRT;

    while ((*ep & STAR) || lp <= NumCharacters || *ep == CKET || *ep == EBUF)
	switch (*ep++) {

	    case CCHR: 
		if (trt[*ep++] != trt[CharAt(lp)]) return (0);
		lp++;
		continue;

	    case CDOT: 
		if (CharAt(lp) == '\n') return (0);
		lp++;
		continue;

	    case CDOL: 
		if (CharAt(lp) == '\n')
		    continue;
		return (0);

	    case CIRC:
		if (lp<=FirstCharacter || CharAt (lp-1)=='\n')
		    continue;
		return 0;

	    case BBUF:
		if (lp<=FirstCharacter)
		    continue;
		return 0;

	    case EBUF:
		if (lp>NumCharacters)
		    continue;
		return 0;

	    case BDOT:
		if (lp<=dot)
		    continue;
		return 0;

	    case EDOT:
		if (lp==dot)
		    continue;
		return 0;

	    case ADOT:
		if (lp>=dot)
		    continue;
		return 0;

	    case WORD:
		if (CharIs (CharAt (lp), WordChar)) {
		    lp++;
		    continue;
		}
		return 0;

	    case NWORD:
		if (!CharIs (CharAt (lp), WordChar)) {
		    lp++;
		    continue;
		}
		return 0;

	    case WBOUND:
		if ((lp<=FirstCharacter || !CharIs (CharAt (lp-1), WordChar)) !=
			(lp>NumCharacters || !CharIs (CharAt (lp), WordChar)))
		    continue;
		return 0;

	    case NWBOUND:
		if ((lp<=FirstCharacter || !CharIs (CharAt (lp-1), WordChar)) ==
			(lp>NumCharacters || !CharIs (CharAt (lp), WordChar)))
		    continue;
		return 0;

	    case CEOF: 
		search_globals.loc2 = lp;
		return (1);

	    case CCL: 
		if (cclass (ep, CharAt(lp), 1)) {
		    ep += *ep;
		    lp++;
		    continue;
		}
		return (0);

	    case NCCL: 
		if (cclass (ep, CharAt(lp), 0)) {
		    ep += *ep;
		    lp++;
		    continue;
		}
		return (0);

	    case CBRA: 
		search_globals.braslist[*ep++] = lp;
		continue;

	    case CKET: 
		search_globals.braelist[*ep++] = lp;
		continue;

	    case CBACK: 
		if (search_globals.braelist[i = *ep++] == 0)
		    error ("bad braces");
		if (backref (i, lp)) {
		    lp += search_globals.braelist[i] - search_globals.braslist[i];
		    continue;
		}
		return (0);

	    case CBACK | STAR: 
		if (search_globals.braelist[i = *ep++] == 0)
		    error ("bad braces");
		curlp = lp;
		while (backref (i, lp)) {
		    lp += search_globals.braelist[i] - search_globals.braslist[i];
		}
		while (lp >= curlp) {
		    if (advance (lp, ep))
			return (1);
		    lp -= search_globals.braelist[i] - search_globals.braslist[i];
		}
		continue;

	    case CDOT | STAR: 
		curlp = lp;
		while (lp++ <= NumCharacters && CharAt(lp-1) != '\n');
		goto star;

	    case WORD | STAR: 
		curlp = lp;
		while (lp++ <= NumCharacters && CharIs (CharAt(lp-1), WordChar));
		goto star;

	    case NWORD | STAR: 
		curlp = lp;
		while (lp++ <= NumCharacters && !CharIs (CharAt(lp-1), WordChar));
		goto star;

	    case CCHR | STAR: 
		curlp = lp;
		while (lp++ <= NumCharacters && trt[CharAt(lp-1)] == trt[*ep]);
		ep++;
		goto star;

	    case CCL | STAR: 
	    case NCCL | STAR: 
		curlp = lp;
		while (lp++ <= NumCharacters
			&& cclass (ep, CharAt(lp-1), ep[-1] == (CCL | STAR)));
		ep += *ep;
		goto star;

	star: 
		do {
		    lp--;
		    if (advance (lp, ep))
			return (1);
		} while (lp > curlp);
		return (0);

	    default: 
		error ("Badly compiled pattern (Emacs internal error!)");
	}
    if (*ep == CEOF || *ep == CDOL) {
	search_globals.loc2 = lp;
	return 1;
    }
    return 0;
}

static
backref (i, lp)
register i;
register lp;
{
    register bp;

    bp = search_globals.braslist[i];
    while (lp <= NumCharacters && CharAt(bp) == CharAt(lp)) {
	bp++;
	lp++;
	if (bp >= search_globals.braelist[i])
	    return (1);
    }
    return (0);
}

static
cclass (set, c, af)
register char  *set;
register    c;
{
    register    n;
    register char  *trt = search_globals.TRT;

    if (c == 0)
	return (0);
    n = *set++;
    while (--n)
	if (trt[*set++] == trt[c])
	    return (af);
    return (!af);
}

static
place (l1, l2)
register l1, l2; {
    while (l1 < l2) {
	InsertAt (dot, CharAt (l1));
	DotRight (1);
	l1++;
    }
}

simplecoms.c    508005728   1094  1000  100644  14702     `
/* process the simple commands */

/*		Copyright (c) 1981,1980 James Gosling		*/

/* Modified DJH 7-Dec-80	Make EndOfLine not back up at end of buffer
				Destatize EndOfLine for Meta-Period
   Modified MKC 22 March 84	arrow keys
 */

#include "buffer.h"
#include "window.h"
#include "keyboard.h"
#include "syntax.h"
#include "mlisp.h"
#include "macros.h"
#include <ctype.h>

static
BeginningOfLine () {
    SetDot (ScanBf ('\n', dot, -1));
    return 0;
}

static
BackwardCharacter () {
    DotLeft (arg);
    if (dot < FirstCharacter){
	SetDot (FirstCharacter);
	error("You're at the beginning of the buffer");
    }
    return 0;
}

static
ExitEmacs () {
    return -1;
}

static
DeleteNextCharacter () {
    DelFrwd (dot, arg);
    return 0;
}

/* DJH -- Don't back up at end of buffer
	  Removed "static" for Meta-Period use
 */
EndOfLine () {
    register ndot = ScanBf ('\n', dot, 1);
    if (dot != ndot) {
	SetDot(ndot);
	if (CharAt (ndot - 1) == '\n')
	    BackwardCharacter ();
    }
    return 0;
}

static
ForwardCharacter () {
    DotRight (arg);
    if (dot > NumCharacters + 1){
	SetDot (NumCharacters + 1);
	error("You're at the end of the buffer.");
    }
    return 0;
}

IllegalOperation () {
    err++;
    return 0;
}

static
DeletePreviousCharacter () {
    DelBack (dot, arg);
    DotLeft (arg);
    return 0;
}

static
NewlineAndIndent () {
    register    DC = CurIndent ();
    SelfInsert ('\n');
    ToCol (DC);
    return 0;
}

static
KillToEndOfLine () {
    register    nd;
    register count = arg;
    register merge = LastProc == KillToEndOfLine;
    register struct buffer *bf;
    do {
	arg = 1;
	nd = dot;
	EndOfLine ();
	nd = dot - nd;
	if (nd <= 0)
	    nd = -1;
	bf = DelToBuf (-nd, merge, 1, "Kill buffer");
	merge = 1;
    } while (--count > 0);
    if (bf) bf->b_mode.md_NeedsCheckpointing = 0;
    return 0;
}

static
RedrawDisplay () {
    extern  ScreenGarbaged;
    ScreenGarbaged++;
    return 0;
}

static
Newline () {
    SelfInsert ('\n');
    return 0;
}

int TrackEol;			/* true iff ^n and ^p should stick with
				   eol's */
static
NextLine() {
    LineMove (0);
    return 0;
}

static
PreviousLine() {
    LineMove (1);
    return 0;
}

static  LineMove (up) {
    register    n = arg;
    static  lastcol;
    register    ndot;
    register    col = 1;
    register    lim = NumCharacters + 1;
    if (n == 0) return 0;
    if (n < 0) n = -n, up = !up;
    if (up)
	n = -n - 1;
    if (LastProc != NextLine && LastProc != PreviousLine)
	lastcol = TrackEol && dot<lim && CharAt(dot)=='\n' ? 9999 : CurCol;
    ndot = ScanBf ('\n', dot, n);
    while (col < lastcol && ndot < lim) {
	n = CharAt (ndot);
	if (n == '\n')
	    break;
	if (n == 011 && bf_mode.md_TabSize >= 1)
	    col = ((col - 1) / bf_mode.md_TabSize + 1)
				* bf_mode.md_TabSize + 1;
	else
	    if (n < 040 || n >= 0177)
		col += CtlArrow? 2 : 4;
	    else
		col += 1;
	ndot++;
    }
    SetDot (ndot);
    DotCol = col;
    ColValid = 1;
    return 0;
}

static
NewlineAndBackup () {
    register int larg = arg;
    SelfInsert ('\n');		/* SelfInsert () zeros arg... */
    DotLeft (larg);
    return 0;
}

static
QuoteCharacter () {
    register abbrev = bf_mode.md_AbbrevOn;
    bf_mode.md_AbbrevOn = 0;
    SelfInsert (GetChar ());
    bf_mode.md_AbbrevOn = abbrev;
    return 0;
}

static
TransposeCharacters () {
    if (dot >= 3) {
	register char   c = CharAt (dot - 1);
	DelBack (dot, 1);
	InsertAt (dot-2, c);
    }
    return 0;
}

static ArgumentPrefixcnt;

static ArgumentPrefix () {
    if (ArgState == NoArg) {
	arg = 4;
	ArgumentPrefixcnt = 1;
    }
    else {
	arg *= 4;
	ArgumentPrefixcnt++;
    }
    ArgState = PreparedArg;
    return 0;
}

CopyRegionToBuffer () {
    register char *name;
    if (bf_cur -> b_mark == 0) {
	error ("Mark not set");
	return 0;
    }
    name = getnbstr(": copy-region-to-buffer ");
    if(name)
	DelToBuf (ToMark (bf_cur -> b_mark) - dot, 0, 0, name);
    return 0;
}

AppendRegionToBuffer () {
    register char *name;
    if (bf_cur -> b_mark == 0) {
	error ("Mark not set");
	return 0;
    }
    name = getnbstr(": append-region-to-buffer ");
    if(name)
	DelToBuf (ToMark (bf_cur -> b_mark) - dot, 1, 0, name);
    return 0;
}

PrependRegionToBuffer () {
    register char *name;
    if (bf_cur -> b_mark == 0) {
	error ("Mark not set");
	return 0;
    }
    name = getnbstr(": prepend-region-to-buffer ");
    if(name)
	DelToBuf (ToMark (bf_cur -> b_mark) - dot, -1, 0, name);
    return 0;
}

DeleteToKillbuffer () {
    register struct buffer *bf;
    if (bf_cur -> b_mark == 0) {
	error ("Mark not set");
	return 0;
    }
    bf = DelToBuf (ToMark (bf_cur -> b_mark) - dot, 0, 1, "Kill buffer");
    if (bf) bf->b_mode.md_NeedsCheckpointing = 0;
    return 0;
}

YankFromKillbuffer () {
    InsertBuffer ("Kill buffer");
    return 0;
}


Minus () {
    if (ArgState == HaveArg && ArgumentPrefixcnt > 0) {
	arg = -arg;
	ArgumentPrefixcnt = -1;
	ArgState = PreparedArg;
	return 0;
    }
    SelfInsert (-1);
    return 0;
}

MetaMinus () {
    ArgumentPrefixcnt = -1;
    arg = -arg;
    ArgState = PreparedArg;
    return 0;
}

Digit () {
    if (ArgState==HaveArg) {
	if (ArgumentPrefixcnt)
	    arg = 0;
	if (arg < 0 || ArgumentPrefixcnt < 0)
	    arg = arg * 10 - (LastKeyStruck - '0');
	else
	    arg = arg * 10 + LastKeyStruck - '0';
	ArgumentPrefixcnt = 0;
	ArgState = PreparedArg;
	return 0;
    }
    SelfInsert (-1);
    return 0;
}

MetaDigit ()
{
    if (ArgState == HaveArg) {
	if (ArgumentPrefixcnt)
	    arg = 0;
	if (arg < 0 || ArgumentPrefixcnt < 0)
	    arg = arg * 10 - (LastKeyStruck - '0');
	else
	    arg = arg * 10 + LastKeyStruck - '0';
	ArgumentPrefixcnt = 0;
	ArgState = PreparedArg;
	return 0;
    }
    else {
	arg = LastKeyStruck - '0';
	ArgumentPrefixcnt = 0;
	ArgState = PreparedArg;
	return 0;
    }
}

/****
Digit () {
    if (ArgState==HaveArg) {
	if (ArgumentPrefixcnt)
	    arg = 0;
	ArgumentPrefixcnt = 0;
	arg = arg * 10 + LastKeyStruck - '0';
	ArgState = PreparedArg;
	return 0;
    }
    SelfInsert (-1);
    return 0;
}
*/

DeleteWhiteSpace () {
    register char   c;
    register    p1,
                p2;
    for (p1 = dot, p2 = NumCharacters;
	    p1 <= p2 && ((c = CharAt (p1)) == ' ' || c == '\t');
	    p1++);
    for (p2 = dot; --p2 >= FirstCharacter && ((c = CharAt (p2)) == ' ' || c == '\t'););
    SetDot (p2 + 1);
    if ((p1 = p1 - p2 - 1) > 0)
	DelFrwd (dot, p1);
    return 0;
}

SelfInsert(c)
register c; {
    register int    p;
    register int    rep = arg;
    if (InputFD != stdin)
	return 0;
    arg = 1;
    if (c < 0)
	c = LastKeyStruck;
    if (bf_mode.md_AbbrevOn && !CharIs (c, WordChar)
	    && (p = dot - 1) >= FirstCharacter && CharIs (CharAt (p), WordChar))
	if (AbbrevExpand ()) return 0;
    do {
	if (c > ' ' && ((p = dot) > NumCharacters || CharAt (p) == '\n'))
	    if (p > FirstCharacter && CurCol > bf_mode.md_RightMargin) {
		register char   bfc;
		if (bf_cur -> b_AutoFillHook) {
		    ExecuteBound (bf_cur -> b_AutoFillHook);
		    if (MLvalue -> exp_type == IsInteger
				&& MLvalue ->exp_int == 0)
			return 0;
		}
		else {
		    while ((p = dot - 1) >= FirstCharacter) {
			bfc = CharAt (p);
			if (bfc == '\n') {
			    p = 0;
			    break;
			}
			if (bfc >= 040 && bfc < 0177)
			    DotCol--, dot--;
			else
			    DotLeft (1);
			if ((bfc == ' ' || bfc == '\t')
				&& CurCol <= bf_mode.md_RightMargin)
			    break;
		    }
		    if (p >= FirstCharacter) {
			DeleteWhiteSpace ();
			arg = 1;
			InsertAt (dot, '\n');
			DotRight (1);
			ToCol (bf_mode.md_LeftMargin);
			if (bf_mode.md_PrefixString[0])
			    InsStr (bf_mode.md_PrefixString);
		    }
		    EndOfLine ();
		}
	    }
	InsertAt (dot, c);
	DotRight (1);
    } while (--rep > 0);
    return 0;
}

static
SetAutoFillHook () {
    int proc = getword (MacNames, ": set-auto-fill-hook to procedure ");
    if (proc >= 0)
	bf_cur -> b_AutoFillHook = MacBodies[proc];
    return 0;
}

SetMarkCommand () {
    if (bf_cur -> b_mark == 0)
	bf_cur -> b_mark = NewMark ();
    SetMark (bf_cur -> b_mark, bf_cur, dot);
    if(interactive) message ("Mark set.");
    return 0;
}

ExchangeDotAndMark () {
    register    old_dot = dot;
    if (bf_cur -> b_mark == 0)
	error ("No mark set in this buffer!");
    else {
	SetDot (ToMark (bf_cur -> b_mark));
	SetMark (bf_cur -> b_mark, bf_cur, old_dot);
    }
    return 0;
}

EraseRegion () {
    if (bf_cur -> b_mark == 0)
	error ("No mark set in this buffer!");
    else {
	register n = ToMark (bf_cur -> b_mark) - dot;
	if (n<0) {
	    n = -n;
	    DotLeft (n);
	}
	DelFrwd (dot, n);
    }
    return 0;
}

/* Delete n (signed) characters from the region around dot, moving them to
   the named buffer.  The text will be prepended to the buffer if where<0,
   will replace the buffer contents if where==0, and will be appended to
   the buffer if where>0.
   The deletion is only actually performed if doit is true.
   DelToBuf returns a pointer to the buffer to which the text was moved. */
struct buffer *
DelToBuf (n, where, doit, name)
char   *name; {
    register    p = dot;
    register struct buffer *old = bf_cur,
                           *kill = FindBf (name);
    if (kill == 0)
	kill = NewBf (name);
    if (where==0)
	EraseBf (kill);
    if (n < 0) {
	n = -n;
	p = p - n;
    }
    if (p < FirstCharacter) {
	n = n + p - FirstCharacter;
	p = FirstCharacter;
    }
    if (p + n > NumCharacters + 1) {
	n = NumCharacters + 1 - p;
    }
    if (n <= 0)
	return kill;
    GapTo (p);
    SetBfp (kill);
    SetDot (where <= 0 ? FirstCharacter : NumCharacters + 1);
    InsCStr (old -> b_base + old -> b_size1 + old -> b_gap, n);
    SetBfp (old);
    if (doit){
	DelFrwd (p, n);
	SetDot (p);
    }
    return kill;
}

/* insert the contents of the named buffer at the current position */
InsertBuffer (name)
char   *name; {
    register struct buffer *who = FindBf (name);
    if (who == 0) {
	error ("non-existant buffer: \"%s\"", name);
	return;
    }
    if (who == bf_cur) {
	error ("Inserting a buffer into itself!");
	return;
    }
    InsCStr (who -> b_base, who -> b_size1);
    InsCStr (who -> b_base + who -> b_size1 + who -> b_gap, who -> b_size2);
}

MoveToCommentColumn () {
    bf_cur->b_mode.md_LeftMargin =
	bf_mode.md_LeftMargin = CurCol == 1 ? 1 : bf_mode.md_CommentColumn;
    ToCol (bf_mode.md_LeftMargin);
    return 0;
}

/* Region restriction manipulation */

WidenRegion () {
    bf_cur -> b_mode.md_HeadClip = bf_mode.md_HeadClip = 1;
    bf_cur -> b_mode.md_TailClip = bf_mode.md_TailClip = 0;
    Cant1WinOpt++;
    return 0;
}

NarrowRegion () {
    if (bf_cur -> b_mark == 0)
	error ("No mark set in this buffer!");
    else {
	register    lo = ToMark (bf_cur -> b_mark);
	register    hi = dot;
	if (hi < lo) {
	    register    t = hi;
	    hi = lo;
	    lo = t;
	}
	bf_cur -> b_mode.md_HeadClip = bf_mode.md_HeadClip = lo;
	bf_cur -> b_mode.md_TailClip = bf_mode.md_TailClip =
		bf_s1 + bf_s2 + 1 - hi;
	Cant1WinOpt++;
    }
    return 0;
}

SaveRestriction () {
    register struct marker
                           *ml = NewMark (),
                           *mh = NewMark ();
    register    rv;
    register struct buffer *b = bf_cur,
                           *b2;
    SetMark (ml, bf_cur, bf_mode.md_HeadClip);
    SetMark (mh, bf_cur, bf_s1 + bf_s2 + 2 - bf_mode.md_TailClip);
    rv = ProgN ();
    b2 = bf_cur;
    b -> b_mode.md_HeadClip = ToMark (ml);
    b -> b_mode.md_TailClip = bf_s1 + bf_s2 + 2 - ToMark (mh);
    DestMark (ml);
    DestMark (mh);
    if (dot < FirstCharacter)
	SetDot (FirstCharacter);
    if (dot > NumCharacters)
	SetDot (NumCharacters + 1);
    if (bf_cur == b2) {
	bf_mode.md_HeadClip = b -> b_mode.md_HeadClip;
	bf_mode.md_TailClip = b -> b_mode.md_TailClip;
    }
    else
	SetBfp (b2);
    Cant1WinOpt++;
    return rv;
}

/* module initialization */

InitSimp () {
    register    n;
#ifdef DumpableEmacs
    if (!Once)
#endif
    {
	setkey (GlobalMap, (Ctl('g')), IllegalOperation, "illegal-operation");
	setkey (GlobalMap, (Ctl('I')), SelfInsert, "self-insert");
	for (n = 040; n < 0177; n++)
	    GlobalMap.k_binding[n] = GlobalMap.k_binding[Ctl('I')];
    	setkey (GlobalMap, ('0'), Digit, "digit");
	for (n = '0'; n<='9'; n++)
	    GlobalMap.k_binding[n] = GlobalMap.k_binding['0'];
	setkey (ESCmap, ('0'), MetaDigit, "meta-digit");
	for (n = '0'; n<='9'; n++)
	    ESCmap.k_binding[n] = ESCmap.k_binding['0'];
	setkey (GlobalMap, '-', Minus, "minus");
	setkey (ESCmap, '-', MetaMinus, "meta-minus");
	TrackEol = 1;		/* true => follow eols on ^n and ^P
				   commands */
	setkey (GlobalMap, (Ctl ('A')), BeginningOfLine, "beginning-of-line");
	setkey (GlobalMap, (Ctl ('B')), BackwardCharacter, "backward-character");
	setkey (GlobalMap, (Ctl ('C')), ExitEmacs, "exit-emacs");
	synkey (CtlXmap, (Ctl ('c')), GlobalMap, (Ctl ('C')));
	synkey (ESCmap, (Ctl ('c')), GlobalMap, (Ctl ('C')));
	setkey (GlobalMap, (Ctl ('D')), DeleteNextCharacter, "delete-next-character");
	setkey (GlobalMap, (Ctl ('E')), EndOfLine, "end-of-line");
	setkey (GlobalMap, (Ctl ('F')), ForwardCharacter, "forward-character");
	setkey (GlobalMap, (Ctl ('H')), DeletePreviousCharacter, "delete-previous-character");
	synkey (GlobalMap, (0177), GlobalMap, (Ctl('H')));
	setkey (GlobalMap, (Ctl ('J')), NewlineAndIndent, "newline-and-indent");
	setkey (GlobalMap, (Ctl ('K')), KillToEndOfLine, "kill-to-end-of-line");
	setkey (GlobalMap, (Ctl ('L')), RedrawDisplay, "redraw-display");
	setkey (GlobalMap, (Ctl ('M')), Newline, "newline");
	setkey (GlobalMap, (Ctl ('N')), NextLine, "next-line");
	setkey (GlobalMap, (Ctl ('O')), NewlineAndBackup, "newline-and-backup");
	setkey (GlobalMap, (Ctl ('P')), PreviousLine, "previous-line");
	setkey (GlobalMap, (Ctl ('Q')), QuoteCharacter, "quote-character");
	setkey (GlobalMap, (Ctl ('T')), TransposeCharacters, "transpose-characters");
	setkey (GlobalMap, (Ctl ('U')), ArgumentPrefix, "argument-prefix");
	setkey (GlobalMap, (Ctl ('W')), DeleteToKillbuffer, "delete-to-killbuffer");
	setkey (GlobalMap, (Ctl ('Y')), YankFromKillbuffer, "yank-from-killbuffer");
	setkey (GlobalMap, (Ctl ('@')), SetMarkCommand, "set-mark");
	setkey (CtlXmap, (Ctl('X')), ExchangeDotAndMark, "exchange-dot-and-mark");

	defproc (MoveToCommentColumn, "move-to-comment-column");
	defproc (SetAutoFillHook, "set-auto-fill-hook");
	defproc (DeleteWhiteSpace, "delete-white-space");
	defproc (CopyRegionToBuffer, "copy-region-to-buffer");
	defproc (AppendRegionToBuffer, "append-region-to-buffer");
	defproc (PrependRegionToBuffer, "prepend-region-to-buffer");
	defproc (EraseRegion, "erase-region");
	defproc (NarrowRegion, "narrow-region");
	defproc (WidenRegion, "widen-region");
	defproc (SaveRestriction, "save-restriction");
    }
}

sindex.c        508005728   1094  1000  100644  467       `
/* Sindex searches for a substring of big which matches small,
   and returns a pointer to this substring.  If no matching
   substring is found, 0 is returned. */

char *sindex (big,small)
register char *big, *small;{
    if (*small==0) return big;
    while (*big) {
	if (*big++ == *small) {
	    register char  *cur = big,
	                   *sp = small;
	    while ((*++sp) && (*sp == *cur++));
	    if (*sp == '\0')
		return (big-1);
	}
    }
    return (0);
}

sleep.c         508005731   1094  1000  100644  636       `
/* Version of sleep() that uses new signal mechanism */
/* ACT 5-Nov-1982 */
#include <signal.h>

static alarmed;

sleep(n)
unsigned n;
{
	int sleepx();
	unsigned altime;
	int (*alsig)();

	if (n==0)
		return;
	altime = alarm(1000);	/* time to maneuver */
	if (altime) {		/* alarm already set */
		if (altime > n)
			altime -= n;/* alarm should go off again later */
		else {
			n = altime;/* sleep ends early */
			altime = 1;/* and alarm goes off again later */
		}
	}
	alsig = signal(SIGALRM, sleepx);
	alarmed = 0;
	alarm(n);
	while (!alarmed)
		pause();
	signal(SIGALRM, alsig);
	alarm(altime);

}

static
sleepx()
{
	alarmed++;
}
spell.c         508939667   1094  1000  100644  10229     `
/* Probabalistic spelling checker for emacs
 *
 * Based on a note in CACM, May 1981 (vol 24, no 5, pp.297,298) by Robert Nix
 *
 * 10 independent random hash functions are computed on the word, and if
 * they all correspond to hash values of a known good word, the word is
 * deemed to be correct.  The hash values are used to index into bitmaps,
 * where a 1 bit indicates that the value is ok.
 *
 * The hash functions are computed using random exor tables, which are
 * saved along with the bitmaps in a file (default name .spelltab on the
 * user's load search path).
 *
 * Frank D. Cringle, 1.2.86
 */

#include <stdio.h>
#include "buffer.h"
#include "config.h"
#include "keyboard.h"
#include "mlisp.h"
#include "window.h"
#ifdef apm
#define gettime(t)	((t) = cputime())
#else
#include <sys/types.h>
#include <sys/times.h>
#define gettime(t)	{struct tms Time;\
			 times(&Time);\
			 (t) = Time.tms_utime;}
#endif

#define CHAR_BITS	 8
#define SHORT_BITS	16
#define LONG_BITS	32
#define N_EXOR		32
#define N_TABLE		8192
#define N_HASH		10
#define EXOR_LONGS	(N_EXOR*SHORT_BITS/LONG_BITS)
#define TABLE_LONGS	(N_TABLE*CHAR_BITS/LONG_BITS)

/* default name of spelling table file */
#define SPELLTAB	".spelltab"

/* the spelltab file is an array of 10 of these structures */
struct HashTab {
	unsigned short Exor[N_EXOR];	/* parameters for hash function */
	unsigned char Table[N_TABLE];	/* bitmap addressed by hash value */
};

static struct HashTab *SpellTab;	/* pointer to hashtables once
					   they have been read in */

static unsigned char BitTable[] = { 128, 64, 32, 16, 8, 4, 2, 1 };

/* Read SpellTab file */
static
GetSpellTab(fn)
register char *fn;		/* filename */
{
    char    stfn[MaxPathNameLen];
    FILE * stf;
    char   *malloc ();

    if (!SpellTab)
	SpellTab = (struct HashTab *) malloc (N_HASH * sizeof *SpellTab);
    if (!SpellTab) {
	error ("Not enough memory for spelling table");
	return 0;
    }
    if ((stf = fopenp (LoadSearchPath, fn, stfn, "r")) == NULL) {
	error ("Can't read %s", fn);
	return 0;
    }
    message ("Loading spelling table...");
    DoDsp (1);
    if ((fread (SpellTab, sizeof (*SpellTab), N_HASH, stf) != N_HASH) ||
	    (getc (stf) != EOF)) {
	error ("wrong file size (%s)", stfn);
	return 0;
    }
    fclose (stf);
    return 1;
}

/* MLisp fuction to read named (or default) spelling table */
static
ReadSpellTab()
{
    register char  *fn = getstr (": read-spelltab ");

    if (!fn)
	return 0;
    if (!*fn)
	fn = SPELLTAB;
    GetSpellTab (fn);
    return 0;
}

/* MLisp function to save the spelling table in a file */
static
WriteSpellTab()
{
    register char  *fn;
    FILE   *stf;
    char    ffn[MaxPathNameLen];

    if (!SpellTab) {
	error ("Spelling table undefined");
	return 0;
    }
    if (!(fn = getstr (": write-spelltab ")))
	return 0;
    if (!*fn)
	fn = SPELLTAB;
    if (abspath (fn, ffn) == -1 || (stf = fopen (ffn, "w")) == NULL) {
	error ("Can't create %s", fn);
	return 0;
    }
    if (fwrite (SpellTab, sizeof (*SpellTab), N_HASH, stf) != N_HASH) {
	error ("Can't write spelling table (%s)", fn);
	return 0;
    }
    fclose (stf);
    return 0;
}

/* MLisp function which creates an empty spelling table */
static
CreateSpellTab()
{
    register    bit,
                i,		/* index over hash tables */
                j,		/* index over long entries per table */
                k;		/* index over bits per long entry */
    register unsigned long  rand,/* LFSR */
                            rand1;/* accumulator for random bit string */
    register struct HashTab *htp;
    register unsigned long *hte;

    if (!SpellTab)
	SpellTab = (struct HashTab *) malloc (N_HASH * sizeof *SpellTab);
    if (!SpellTab) {
	error ("Not enough memory for spelling table");
	return 0;
    }
    gettime (rand);		/* random number seed */
    rand1 = 0;
    for (i = 0, htp = SpellTab; i < N_HASH; i++, htp++) {
	for (j = 0, hte = (unsigned long *) htp -> Exor; j < EXOR_LONGS; j++) {
	    for (k = 0; k < N_EXOR; k++) {
		for (;;) {
		    bit = rand & 1;
		    rand >>= 1;
		    if (bit)
			rand ^= 0x80030001;
		    if (rand)
			break;
		    gettime (rand);
		}
		rand1 = (rand1 << 1) + bit;
	    }
	    *hte++ = rand1;
	}
    /* clear the table down to zeros */
	for (j = 0, hte = (unsigned long *) htp -> Table; j < TABLE_LONGS; j++)
	    *hte++ = 0;
    }
    return 0;
}

/* internal single word spelling check */
static
Lookup(word)
char *word;
{
    register    i;
    register char  *cp;
    register unsigned short H;
    register struct HashTab *htp;

    if (!word || !*word)
	return 0;
    if (!SpellTab && !GetSpellTab (SPELLTAB))
	return 0;
    for (i = 0, htp = SpellTab; i < N_HASH; i++, htp++) {
	for (H = 0, cp = word; *cp;) {
	    H = (H & 0x8000) ? (H << 1) + 1 : (H << 1);
	    H ^= htp -> Exor[*cp++ & (N_EXOR-1)];
	}
	if (!(htp -> Table[(H >> 3) & (N_TABLE-1)] &
			BitTable[H & (CHAR_BITS-1)]))
	    return 0;		/* bad spelling */
    }
    return 1;			/* result = ok */
}

/* MLisp function to check the spelling of one word */
static
CheckSpelling()
{
    char   *word = getstr (": check-spelling ");

    MLvalue -> exp_type = IsInteger;
    MLvalue -> exp_int = Lookup(word);
    return 0;
}

/* insert word in the table */
static
InsertWord(word)
char *word;
{
    register    i,		/* index over hash tables */
                conflict = 1;	/* reset if word not already in table */
    register char  *cp;
    register unsigned short H;
    register struct HashTab *htp;

    if (!word || !*word)
	return 0;
    if (!SpellTab) {
	error ("Spelling table undefined");
	return 0;
    }
    for (i = 0, htp = SpellTab; i < N_HASH; i++, htp++) {
	for (H = 0, cp = word; *cp;) {
	    H = (H & 0x8000) ? (H << 1) + 1 : (H << 1);
	    H ^= htp -> Exor[*cp++ & (N_EXOR - 1)];
	}
	conflict &= ((htp -> Table[(H >> 3) & (N_TABLE - 1)] &
				    BitTable[H & (CHAR_BITS - 1)]) != 0);
	htp -> Table[(H >> 3) & (N_TABLE - 1)] |= BitTable[H & (CHAR_BITS - 1)];
    }
    return conflict;
}

/* internal function which suggests alternate spelling of word */
#define Accept(w)	(InsStr(w), InsCStr("\n", 1), result++)
static
SugSpell(word)
char *word;
{
    register    i,
                j,
                result = 0;
    register    length = strlen (word);
    char    buf[100];

    if (length < 2)
	return 0;
    if (length > 100 - 2) {
	InsStr (word);
	InsStr (" too long!");
	return 1;
    }
 /* delete letters */
    for (i = 0; i < length; i++) {
	strncpy (buf, word, i);
	strncpy (buf + i, word + i + 1, length - i - 1);
	buf[length-1] = '\0';
	if (Lookup (buf))
	    Accept (buf);
    }
 /* change letters */
    for (i = 0; i < length; i++) {
	strcpy (buf, word);
	for (j = 'A'; j <= 'Z'; j++) {
	    if ((buf[i] & 0xdf) == j)
		continue;
	    buf[i] = j | (buf[i] & 0x20);	/* retain same case */
	    if (Lookup (buf))
		Accept (buf);
	}
    }
/* transpose letters */
    for (i = 0; i < length - 1; i++) {
	strcpy (buf, word);
	j = buf[i];
	buf[i] = buf[i + 1];
	buf[i + 1] = j;
	if (Lookup (buf))
	    Accept (buf);
    }
/* insert letters */
    for (i = 0; i <= length; i++)
	for (j = 'A'; j <= 'Z'; j++) {
	    strncpy (buf, word, i);
	    buf[i] = j | ((i < length ? word[i] : word[i-1]) & 0x20);
	    strncpy (buf + i + 1, word + i, length - i);
	    buf[length + 1] = '\0';
	    if (Lookup (buf))
		Accept (buf);
	}
    return result;
}

/* MLisp function which generates suggested alternate spellings of a word */
static
SuggestSpellings()
{
    char   *word = getstr (": suggest-spellings for ");
    char    bword[100];
    char   *buffer;
    struct buffer  *this_buffer;

    if (!word || !*word)
	return 0;
    strncpy (bword, word, 100);
    buffer = getstr (": suggest-spellings for %s in buffer ", bword);
    if (!buffer)
	return 0;
    if (!*buffer)
	buffer = "Spellings";
    this_buffer = bf_cur;
    SetBfn (buffer);
    EraseBuffer ();
    MLvalue -> exp_type = IsInteger;
    MLvalue -> exp_int = SugSpell (bword);
    SetBfp (this_buffer);
    return 0;
}

/* MLisp function which asserts a word in the table */
static
AssertSpelling()
{
    char *word = getstr (": assert-spelling ");

    MLvalue -> exp_type = IsInteger;
    MLvalue -> exp_int = InsertWord(word);
    return 0;
}

/* MLisp function which asserts all words in a file */
static
AssertFile()
{
    register    i,
                conflicts = 0;
    register char  *cp;
    char   *fn = getstr (": assert-file ");
    char    ffn[MaxPathNameLen],
            buf[BUFSIZ];
    FILE * input;

    MLvalue -> exp_type = IsInteger;
    MLvalue -> exp_int = 0;	/* conflict count */
    if (!fn || !*fn)
	return 0;
    if (abspath (fn, ffn) == -1 || (input = fopen (ffn, "r")) == NULL) {
	error ("Can't open %s", ffn);
	return 0;
    }
    while (!feof (input)) {
	cp = buf;
	while ((*cp = getc (input)) != EOF)
	    if (*cp > ' ')
		break;
	while ((*++cp = getc (input)) != EOF)
	    if (*cp <= ' ')
		break;
	*cp = '\0';
	if (cp - buf > 2)
	    conflicts += InsertWord (buf);
    }
    fclose (input);
    MLvalue -> exp_int = conflicts;
    return 0;
}

/* MLisp function which calculates the percentage of bits set in the table */
static
SpellTabLoading()
{
    register    i,
                j,
                sum = 0;
    register struct HashTab *htp;
    register unsigned char *cp;
    static char BitCount[] = {
	0, 1, 1, 2, 1, 2, 2, 3,
	1, 2, 2, 3, 2, 3, 3, 4
    };

    if (!SpellTab) {
	error ("Spelling table undefined");
	return 0;
    }
    for (i = 0, htp = SpellTab; i < N_HASH; i++, htp++)
	for (j = 0, cp = htp -> Table; j < N_TABLE; j++, cp++) {
	    sum += BitCount[*cp & 15];
	    sum += BitCount[(*cp >> 4) & 15];
	}
    MLvalue -> exp_type = IsInteger;
    MLvalue -> exp_int = (sum * 100) / (N_TABLE * CHAR_BITS * N_HASH);
				/* percent loading */
    return 0;
}

InitSpell()
{
    DefIntVar ("spelltab-loaded", (int *) &SpellTab);
    defproc (ReadSpellTab, "read-spelltab");
    defproc (WriteSpellTab, "write-spelltab");
    defproc (CreateSpellTab, "create-spelltab");
    defproc (CheckSpelling, "check-spelling");
    defproc (SuggestSpellings, "suggest-spellings");
    defproc (AssertSpelling, "assert-spelling");
    defproc (AssertFile, "assert-file");
    defproc (SpellTabLoading, "spelltab-loading");
}

subprogram.c    509793427   1094  1000  100644  10225     `
#include <stdio.h>
#include "buffer.h"
#include "keyboard.h"
#include "mlisp.h"
#include "subprogram.h"
#include "window.h"

PFI KeyBoardGet = (PFI) -1;
PFI ScreenPut = (PFI) -1;
PFI InputRoutine;
PFI OutputRoutine;
struct InputNode SPInput;

#define ChunkSize 500		/* amount to truncate when buffer overflows */
static int ProcessBufferSize;   /* Maximum size for process buffer */
#define GetVector(v) { \
    asm ("	movw	v+2,.d0"); \
    asm ("	extl	.d0"); \
    asm ("	addl	#v+4,.d0"); \
    asm ("	movl	.d0,.a1"); \
}

/* Define a routine which is to be called by subprograms to get
   their input characters.
   If the routine pointer is NULL, input is reconnected to the
   keyboard.
   The routine must return the next character in the input stream;
   EOF should be signaled by a return value of -1.
*/

static int bufc;		/* buffered char for testsymbol */

ConnectInput(In)
PFI In;
{
    InputRoutine = In;
    bufc = -1;
    if (In) {
	asm ("	lea	[Inadr,.a4],.a0");
	asm ("	movl	.a0,0x35d6");		/* stream 0 input service */
	GetVector (0x10d4);
	asm ("	movl	.a0,.a1@");		/* testsymbol */
	asm ("	lea	[OIenter,.a4],.a0");
	GetVector (0x10f0);
	asm ("	movl	.a0,.a1@");		/* openinput */
	asm ("	lea	[CIenter,.a4],.a0");
	GetVector (0x10e8);
	asm ("	movl	.a0,.a1@");		/* closeinput */
    }
    else {
	asm ("	lea	[TScont,.a4],.a0");
	GetVector (0x10d4);
	asm ("	movl	.a0@,.a1@");		/* testsymbol */
	asm ("	lea	[OIcont,.a4],.a0");
	GetVector (0x10f0);
	asm ("	movl	.a0@(2),.a1@");		/* openinput */
	asm ("	lea	[CIcont,.a4],.a0");
	GetVector (0x10e8);
	asm ("	movl	.a0@(2),.a1@");		/* closeinput */
	PKeyBoardGet = KeyBoardGet;
    }
}


static
InInterface(bump)
register bump;
{
/* do not use a6 in this routine! It does not get initiliased */
    register int    c;

    asm ("	.text");
    asm ("Inadr:	moveml	#0x0308,.sp@-");/* push d6,d7,a4 */
    asm ("	movl	#-1,.a4");   /* true address filled in by InitProg */
    asm ("d:	movl	.d1,.d7");		/* parameter to bump */

    c = (bufc == -1) ? InputRoutine () : bufc;
    bufc = bump ? -1 : c;
    if (c == EOF) {
	asm ("	lea	[Inadr,.a4],.a0");	/* C RTS does */
	asm ("	movl	.a0,0x35d6");		/*   openinput(":t") */
	asm ("	moveml	.sp@+,#0x10c0");	/* pop a4,d6,d7 */
	asm ("	moveml	.sp@+,#0x0707");	/* pop d0-d2,a0-a2 */
	asm ("	moveq	#-0x19,.d0");		/* event 9,1 */
	asm ("	jmp	0x1114");		/* signal event */
    }
    else {
	asm ("	movl	.d6,.d0");
	asm ("	moveml	.sp@+,#0x10c0");	/* pop a4,d6,d7 */
	asm ("	movl	.d0,.sp@");
	asm ("	moveml	.sp@+,#0x0707");	/* pop d0-d2,a0-a2 */
	asm ("	rts");

	asm ("OIenter:	tstl	.d0");		/* intercept openinput */
	asm ("	bne	OIcont");		/* if stream 0 */
	asm ("	rts");				/* ignore it */
	asm ("OIcont:	jmp	0");		/* filled in later */
	asm ("CIenter:	cmpl	#0x35ce,0x35c6");/* curin == in0 ? */
	asm ("	bne	CIcont");		/* if stream 0 */
	asm ("	rts");				/* ignore it */
	asm ("CIcont:	jmp	0");		/* filled in later */
    }
}

/* Define a routine which is to accept output characters from a
   subprogram.  The single parameter is the output character.
   If the routine pointer is NULL, output is reconnected to the
   screen.  The routine does not return a value.
 */

ConnectOutput(Out)
PFI Out;
{
    OutputRoutine = Out;
    if (Out) {
	asm ("	lea	[Outadr,.a4],.a0");
	asm ("	movl	.a0,0x3fa4");
    }
    else
	PScreenPut = ScreenPut;
}

static
OutInterface(c)
register c;
{

    asm ("	.text");
    asm ("Outadr:	moveml	#0x0108,.sp@-"); /* push d7, a4 */
    asm ("	movl	#-1,.a4"); /* true address filled in by InitProg */
    asm ("	movl	.d0,.d7");		/* parameter to c */

    OutputRoutine (c);

    asm ("	moveml	.sp@+,#0x1080");	/* pop a4, d7 */
    asm ("	rts");
}

static
ProvideInput()
{
    register struct marker *sm = SPInput.startmark;
    struct buffer *oldbuffer;

    while (1) {
	if (SPInput.point < SPInput.end)
	    return * SPInput.point++;
	if (SPInput.flag == 0)
	    return - 1;
	if (sm == NULL)
	    SPInput.startmark = sm = NewMark ();
	SetMark (sm, bf_cur, NumCharacters + 1);
	oldbuffer = bf_cur;
	emask = -1;
	RecursiveEdit ();
	emask = 0;
	SetBfp (oldbuffer);
	WindowOn (bf_cur);
	GapTo (NumCharacters + 1);
	SPInput.point = bf_p1 + sm -> m_pos;
	SPInput.end = bf_p1 + bf_s1 + 1;
    }
}

static
StuffOutput(c)
char c;
{

    if ((bf_s1 + bf_s2) > ProcessBufferSize) {
	DelFrwd (1, ChunkSize);
	DotLeft (ChunkSize);
    }
    if (SPInput.display == 2 || (SPInput.display && c == '\n'))
	DoDsp (1);
    if (c != '\r')
	InsCStr (&c, 1);	/* insert the character at dot */
}

/* execute a subprocess with the output being stuffed into the named buffer. */
ExecBf (buffer, erase, com)
char   *buffer,
* com; {
    struct buffer  *old = bf_cur;

    SetBfn (buffer);
    if (interactive)
	WindowOn (bf_cur);
    if (erase)
	EraseBf (bf_cur);
    if (interactive && SPInput.display)
	DoDsp (1);
    SetMarkCommand ();
    ConnectInput (ProvideInput);
    ConnectOutput (StuffOutput);
    emask = 0;
    system (com);
    emask = -1;
    ConnectInput (NULLFUNC);
    ConnectOutput (NULLFUNC);
    DestMark (SPInput.startmark);
    if (erase) {
	ExchangeDotAndMark ();
	bf_modified = 0;
    }
    if (interactive)
	WindowOn (old);
}

/* pass the region starting at dot and extending for n characters through
   the command.  The old contents of the region is left in the kill
   buffer */
FilterThrough(n, command)
char *command;
{
    register struct buffer *kill = DelToBuf (n, 0, 1, "Kill buffer");

    ClearSPI;
    if (kill) {
	kill -> b_mode.md_NeedsCheckpointing = 0;
	SPInput.point = kill -> b_base;
	SPInput.end = kill -> b_base + kill -> b_size1;
    }
    ExecBf (bf_cur -> b_name, 0, command);
    bf_modified++;
}

IndentCProcedure () {
    register    pos = search ("^}", 1, dot - 3, 1);
    register    spos;
    register    nest = 0;
    if (pos <= 0) {
	error ("Can't find procedure boundary");
	return 0;
    }
    spos = pos;
    pos = ScanBf ('\n', pos, 1);
    while (spos > 1) {
	register char   c = CharAt (spos);
	if (c == '}')
	    nest++;
	if (c == '{') {
	    nest--;
	    if (nest <= 0)
		break;
	}
	spos--;
    }
    if (nest == 0) {
	SetDot (ScanBf ('\n', spos, -1));
	FilterThrough (pos - dot, "emacs:indent -st");
    }
    else
	error ("Can't find procedure boundary");
    return 0;
}

static
FilterRegion () {
    register char  *s;
    if (bf_cur -> b_mark == 0) {
	error ("Mark not set");
	return 0;
    }
    s = getstr (": filter-region (through command) ");
    if (s) {
	char    saveit[300];
	strcpy (saveit, s);	/* what the world needs is a language with
				   real strings. */
	FilterThrough (ToMark (bf_cur -> b_mark) - dot, saveit);
    }
    return 0;
}

static char
CompileCommand[300];

StrFunc (CompileCommandString, CompileCommand);

CompileIt () {
    register char  *com = 0;
    register struct buffer *old = bf_cur;

    ClearSPI;
    SPInput.display++;
    if (ModWrite ()) {
	/* this test really shouldn't be done this way, all the prefix numeric
		argument stuff needs to be rationalized */
	if (ArgState == HaveArg || !interactive || !*CompileCommand) {
	    com = getstr ("Compilation command: ");
	    if (com == 0)
		return 0;
	    if (*com)
		strcpy (CompileCommand, com);
	}
	SetBfn ("Error log");
	bf_cur -> b_mode.md_NeedsCheckpointing = 0;
	EraseBf (bf_cur);
	InsStr (CompileCommand);
	SelfInsert ('\n');
	SetBfp (old);
	message ("Running %s", CompileCommand);
	ExecBf ("Error log", 0, CompileCommand);
	SetBfn ("Error log");
	ExchangeDotAndMark ();
	bf_modified = 0;
	if (!err)
	    ParseErb (1, NumCharacters);
	SetBfp (old);
	message ("Done!");
    }
    return 0;
}

ExecuteMonitorCommand () {
    register    InThisBuffer = ArgState == HaveArg;
    char   *com = getstr ("APM command: ");
    if (com == 0)
	return 0;
    ClearSPI;
    if (InThisBuffer)
	ExecBf (bf_cur -> b_name, 0, com);
    else {
	SPInput.display++;
	SetBfn ("Command Execution");
	bf_cur -> b_mode.md_NeedsCheckpointing = 0;
	ExecBf (bf_cur -> b_name, 1, com);
    }
    return 0;
}

NextError () {
    NextErr ();
    return 0;
}

/* Parse all of the error messages found in a region */
ParseErrorMessagesInRegion () {
    register    left,
                right = dot;
    if (bf_cur -> b_mark == 0)
	error ("Mark not set.");
    else {
	left = ToMark (bf_cur -> b_mark);
	if (left > right)
	    right = left, left = dot;
	ParseErb (left, right);
    }
    return 0;
}

/* Emacs command to start up a subprogram: uses "Command Execution"
   buffer if one is not specified.  Also does default stuffing
*/
StartProgram () {
    register char  *com = (char *) (savestr (getstr ("Command: ")));
    register char  *buf;
    register    erase = 0;

    if ((com == 0) || (*com == 0)) {
	error ("No command");
	return 0;
    }
    buf = (char *) getstr ("Connect to buffer: ");
    if (*buf == 0) {
	buf = "Command execution";
	erase++;
    }
    ClearSPI;
    SPInput.flag++;
    SPInput.display++;
    ExecBf (buf, erase, com);
    return 0;
}

InitProg()
{
/* save initial values of i/o service routines */
    KeyBoardGet = PKeyBoardGet;
    ScreenPut = PScreenPut;
/* fix addresses in interface routines */
    asm ("	lea	[Inadr,.a4],.a0");
    asm ("	movl	.a4,.a0@(6)");

    asm ("	lea	[Outadr,.a4],.a0");
    asm ("	movl	.a4,.a0@(6)");

    asm ("	lea	[OIcont,.a4],.a0");
    GetVector (0x10f0);		/* openinput */
    asm ("	movl	.a1@,.a0@(2)");

    asm ("	lea	[CIcont,.a4],.a0");
    GetVector (0x10e8);		/* closeinput */
    asm ("	movl	.a1@,.a0@(2)");

    asm ("	lea	[TScont,.a4],.a0");
    GetVector (0x10d4);		/* testsymbol */
    asm ("	movl	.a1@,.a0@");

    asm ("	.data");
    asm ("TScont:	.long	1");
    asm ("	.text");
    ProcessBufferSize = 50000;	/* # of chars in buffer before truncating 
				*/
    DefIntVar ("process-buffer-size", &ProcessBufferSize);
    defproc (FilterRegion, "filter-region");
    defproc (ParseErrorMessagesInRegion, "parse-error-messages-in-region");
    defproc (StartProgram, "start-program");
    defproc (CompileCommandString, "compile-command");
    setkey (CtlXmap, (Ctl ('E')), CompileIt, "compile-it");
    setkey (CtlXmap, (Ctl ('N')), NextError, "next-error");
    setkey (CtlXmap, ('!'), ExecuteMonitorCommand, "execute-monitor-command");
    setkey (ESCmap, ('j'), IndentCProcedure, "indent-C-procedure");
}

syntax.c        508005729   1094  1000  100644  7684      `
/* Emacs routines to deal with syntax tables */
/*		Copyright (c) 1980 James Gosling		*/

#include <ctype.h>
#include "keyboard.h"
#include "buffer.h"
#include "window.h"
#include "mlisp.h"
#include "syntax.h"

#define MaxSyntaxTables 40	/* the maximum number of syntax tables */

static
char *SyntaxTableNames[MaxSyntaxTables];
static
struct SyntaxTable *SyntaxTables[MaxSyntaxTables];
static
int NumberOfSyntaxTables;

static				/* given the name of a syntax table, return
				   a pointer to it.  If it doesn't exist,
				   create it */
struct SyntaxTable *locate(name)
char *name;
{
    register    i = 0;
    register struct SyntaxTable *p;
    if(name==0 || *name==0) return 0;
    while (i < NumberOfSyntaxTables)
	if (strcmp (SyntaxTableNames[i], name) == 0)
	    return SyntaxTables[i];
	else i++;
    if (NumberOfSyntaxTables >= MaxSyntaxTables) {
	error ("Too many syntax tables!");
	return 0;
    }
    p = (struct SyntaxTable *) malloc (sizeof *p);
    SyntaxTables[NumberOfSyntaxTables] = p;
    *p = GlobalSyntaxTable;
    SyntaxTableNames[NumberOfSyntaxTables] = p -> s_name = savestr (name);
    NumberOfSyntaxTables++;
    return p;
}

static
UseSyntaxTable () {		/* select a named syntax table for this
				   buffer and turn on syntax mode if it
				   or the global syntax table is
				   non-empty */
    register struct SyntaxTable *p = 
	locate (getnbstr (": use-syntax-table "));
    if (p == 0)
	return 0;
    bf_cur -> b_mode.md_syntax = bf_mode.md_syntax = p;
    return 0;
}

ModifySyntaxEntry () {
    register char  *p;
    if (bf_mode.md_syntax == &GlobalSyntaxTable)
	error ("You'll have to specify a syntax table.");
    else
	if (p = getstr (": modify-syntax-entry ")) {
	    struct SyntaxTableEntry s;
	    switch (*p++) {
		case ' ': 
		case '-': 
		    s.s_kind = DullChar;
		    break;
		case 'w': 
		    s.s_kind = WordChar;
		    break;
		case '(': 
		    s.s_kind = BeginParen;
		    break;
		case ')': 
		    s.s_kind = EndParen;
		    break;
		case '"': 
		    s.s_kind = PairedQuote;
		    break;
		case '\\':s.s_kind = PrefixQuote;
		    break;
		default: 
		    goto syntax_error;
	    }
	    if (strlen (p) < 5)
		goto syntax_error;
	    s.MatchingParen = *p++;
	    s.BeginComment = *p++ == '{';
	    s.EndComment = *p++ == '}';
	    s.CommentAux = *p++;
	    while (*p) {
		register char   c = *p++,
		                lim;
		if (*p != '-')
		    lim = c;
		else
		    if (*++p)
			lim = *p++;
		    else
			goto syntax_error;
		while (c <= lim)
		    bf_mode.md_syntax -> s_table[c++] = s;
	    }
	}
    return 0;
syntax_error: error ("Bogus modify-syntax-table directive.   [TP{}Cc]");
    return 0;
}


/* Primitive function for paren matching.  Leaves dot at enclosing left
   paren, or at top of buffer if none.  Stops at a zero-level newline if
   StopAtNewline is set.  Returns (to MLisp) 1 if it finds
   a match, 0 if not  */
/* Bugs: doesn't correctly handle comments (it'll never really handle them
   correctly... */

static
ParenScan (StopAtNewline, forward) {
    register    ParenLevel = 0;
    register char   c,
                    pc;
    char    parenstack[200];
    int     InString = 0;
    char    MatchingQuote = 0;
    register struct SyntaxTable *s = bf_mode.md_syntax;
    register    enum SyntaxKinds k;
    register on_on = 1;
    int start = (forward ? (dot+1) : dot);

    parenstack[0] = 0;
    MLvalue -> exp_type = IsInteger;
    MLvalue -> exp_int = 0;
    if (StopAtNewline)
        {register p1, p2, dp;
	 for (p1 = dot - 1, p2 = (forward ? NumCharacters : FirstCharacter), 
	 		    dp = (forward ? 1 : -1);
		(forward ? p1<p2 : p1>p2)
		&& ((c = CharAt(p1)) == ' ' || c == '\t' || c == '\n');
	     p1 += dp) ;
	 SetDot(p1+1);
	}
    while (on_on && !err) 
       {if (forward) 
           {if (dot > NumCharacters)
		return 0;
	    DotRight (1);
	   }
	if (dot > 2)
	    pc = CharAt (dot - 2);
	else {
	    pc = 0;
	    if (dot <= FirstCharacter)
		return 0;
	}
	k = s -> s_table[c = CharAt (dot - 1)].s_kind;
	if (s -> s_table[pc].s_kind == PrefixQuote)
	    k = WordChar;
	if ((!InString || c == MatchingQuote) && k == PairedQuote) {
	    InString = !InString;
	    MatchingQuote = c;
	}
	if (InString && c == '\n')
	    return 0;
	if (StopAtNewline && c == '\n' && ParenLevel == 0)
	    return 0;
	if (!InString && (k == EndParen || k == BeginParen))
	   {
	    if ((forward == 0) == (k == EndParen)) {
		ParenLevel++;
		parenstack[ParenLevel] = s -> s_table[c].MatchingParen;
	    }
	    else {
		if (ParenLevel > 0 && parenstack[ParenLevel] != c)
		    error ("Parenthesis mismatch.");
		ParenLevel--;
	    }
	    if (pc == '\n' && ParenLevel > 0 && dot != start)
	        {error("Parenthesis context across function boundary");
		 return 0;
		}
	    if (ParenLevel < 0 || (ParenLevel == 0 && !StopAtNewline))
	        on_on = 0;
	   }
	if (!forward)
	    DotLeft (1);
    }
    MLvalue -> exp_int = 1;
    return 0;
}

/*  Primitive function for lisp indenting.   Searches backward till it finds
    the matching left paren, or a line that begins with zero paren-balance.
    Returns the paren level at termination to mlisp.  */
static
BackwardParenBL () {
    ParenScan (1, 0);
    return 0;
}

/* Searches backward until it find the matching left paren */
static
BackwardParen () {
    ParenScan (0, 0);
    return 0;
}

static
ForwardParenBL () {
    ParenScan (1, 1);
    return 0;
}

/* Searches forward until it find the matching left paren */
static
ForwardParen () {
    ParenScan (0, 1);
    return 0;
}

/* Function to dump syntax table to buffer in human-readable format */
DumpSyntaxTable() {
    register struct SyntaxTable *p;
    register i, j;
    register struct SyntaxTableEntry *ip, *jp;
    register struct buffer *old = bf_cur;
    char line[300];
    char c;
    
    p = locate (getnbstr (": dump-syntax-table "));
    if (p == 0)
	return 0;
    SetBfn ("Syntax table");
    if (interactive) WindowOn (bf_cur);
    WidenRegion ();
    EraseBf (bf_cur);
    InsStr ("Chars	TP MP BC EC CA\n----------------------\n");
    for (i=0; i<128; i = j+1) {
	ip = &p->s_table[i];
	for (j = i; j<127
		&& ip->s_kind  == (jp = &p->s_table[j+1])->s_kind
		&& ip->BeginComment == jp->BeginComment
		&& ip->MatchingParen == jp->MatchingParen
		&& ip->EndComment == jp->EndComment
		&& ip->CommentAux == jp->CommentAux; j++);
	switch(ip->s_kind) {
	    case DullChar:
		c = ' ';
		break;
	    case WordChar:
		c = 'w';
		break;
	    case BeginParen:
		c = '(';
		break;
	    case EndParen:
		c = ')';
		break;
	    case PairedQuote:
		c = '"';
		break;
	    case PrefixQuote:
		c = '\\';
		break;
	}
	sprintfl(line, sizeof line, i<040 ? "'\\%o" : "'%c", i);
	if (i!=j) sprintf(line+strlen(line),j<040 ? "'-'\\%o" : "'-'%c",j);
	sprintf(line+strlen(line),"'	 %c  %c  %c  %c  %c\n",
		c,
		ip->MatchingParen ? ip->MatchingParen:' ',
		ip->BeginComment ? '{' : ' ',
		ip->EndComment ? '}' : ' ',
		ip->CommentAux ? ip->CommentAux :' ');
	InsStr (line);
    }
    bf_cur -> b_mode.md_NeedsCheckpointing = 0;
    bf_modified = 0;
    SetDot (1);
    SetBfp (old);
    WindowOn (bf_cur);
    return 0;
}

InitSyntax () {
    register    i;
    GlobalSyntaxTable.s_name = "global-syntax-table";
    for (i = 0; i < 128; i++)
	GlobalSyntaxTable.s_table[i].s_kind =
	    isalnum (i) ? WordChar : DullChar;
    defproc (UseSyntaxTable, "use-syntax-table");
    defproc (DumpSyntaxTable, "dump-syntax-table");
    defproc (BackwardParenBL, "backward-balanced-paren-line");
    defproc (BackwardParen, "backward-paren"); /* APW */
    defproc (ForwardParenBL, "forward-balanced-paren-line");
    defproc (ForwardParen, "forward-paren");
    defproc (ModifySyntaxEntry, "modify-syntax-entry");
}
undo.c          508005727   1094  1000  100644  4287      `
/* Support routines for the undo facility */

#include "buffer.h"
#include "window.h"
#include "keyboard.h"
#include "undo.h"

#ifdef apm
#define STATIC
#else
#define STATIC static
#endif

STATIC struct UndoRec UndoRQ[NUndoR];	/* The undo records */
STATIC char	      UndoCQ[NUndoC];	/* And the characters associated with
					   them */

static FillRQ;
static FillCQ;
static NUndone;
static NCharsLeft;
static LastUndoneC;
static struct UndoRec *LastUndone;
static struct UndoRec *LastUndoRec;
static struct UndoRec *SecondToLastUndoRec;

struct UndoRec *NewUndo (kind, dot, len)
enum Ukinds kind; {
    register struct UndoRec *p = &UndoRQ[FillRQ];
    register struct UndoRec *np;
    if (FillRQ >= NUndoR) {
	FillRQ = 0;
	np = UndoRQ;
    } else {
	FillRQ++;
	np = p+1;
    }
    np -> kind = Unundoable;
    p -> kind = kind;
    p -> buffer = bf_cur;
    p -> dot = dot;
    p -> len = len;
    SecondToLastUndoRec = LastUndoRec;
    LastUndoRec = p;
    if (kind != Uboundary)
	LastUndone = 0;
    return p;
}

RecordInsert (dot, n) {
    register struct UndoRec *p = LastUndoRec;
    if (p && p -> kind == Udelete && p -> dot + p -> len == dot)
	p -> len += n;
    else
	NewUndo (Udelete, dot, n);
}

RecordDelete (dot, n)
register    dot; {
    register struct UndoRec *p = LastUndoRec;
    if (p && p -> kind == Uinsert && p -> dot + p -> len == dot)
	p -> len += n;
    else
	NewUndo (Uinsert, dot, n);
    NCharsLeft -= n;
    while (--n >= 0) {
	UndoCQ[FillCQ] = CharAt (dot);
	if (FillCQ >= NUndoC)
	    FillCQ = 0;
	else
	    ++FillCQ;
	dot++;
    }
}

DoneIsDone () {
    NewUndo (Unundoable, dot, 0);
    return 0;
}

UndoBoundary () {
    register struct UndoRec *p = SecondToLastUndoRec;

    /* Do not push sonsecutive boundaries, they only represent movement, not
       change. Save one movement, however, for clarity. BNI 21-Oct-82 */

    /* The below should handle the deleting of movements where you end up
       at the same place you started. BNI 21-Oct-82 */

    if (p && p -> kind == Uboundary && LastUndoRec -> kind == Uboundary &&
	p -> dot == dot && p -> buffer == bf_cur) {
	    register struct UndoRec *saveold = LastUndoRec;
	    
	    LastUndoRec = SecondToLastUndoRec;
	    SecondToLastUndoRec = 0;
	    saveold -> kind = Unundoable;
	    if (--FillRQ < 0)
		FillRQ = NUndoR-1;
    }
    else if (p && p->kind == Uboundary && (p=LastUndoRec)->kind == Uboundary) {
	p -> dot = dot;
	p -> buffer = bf_cur;
    }
    else
	NewUndo (Uboundary, dot, 0);
    return 0;
}

Undo () {
    arg++;
    LastUndone = LastUndoRec;
    NCharsLeft = NUndoC;
    NUndone = 0;
    LastUndoneC = FillCQ;
    UndoMore ();
}

UndoMore () {
    register struct UndoRec *p = LastUndone;
    register    n = 0;
    register    chars;
    if (p == 0) {
	error ("Cannot undo more: changes have been made since the last undo");
	return 0;
    }
    while (1) {
	while (p -> kind != Uboundary) {
	    if (p -> kind == Uinsert && (NCharsLeft -= p -> len) < 0
		    || p -> kind == Unundoable || NUndone >= NUndoR) {
		error ("Sorry, I can't undo that.  What's done is done.");
		return 0;
	    }
	    NUndone++;
	    n++;
	    p--;
	    if (p < UndoRQ)
		p = &UndoRQ[NUndoR - 1];
	}
	NUndone++;
	n++;
	if (--arg <= 0)
	    break;
	p--;
	if (p < UndoRQ)
	    p = &UndoRQ[NUndoR - 1];
    }
    p = LastUndone;
    chars = LastUndoneC;
    while (--n >= 0) {
	if (bf_cur != p -> buffer)
	    SetBfp (p -> buffer);

	/* only handle records for existing buffers.  BNI 21-Oct-82 */

	if (bf_cur == p -> buffer) {
	    SetDot (p -> dot);
	    switch (p -> kind) {
		case Uboundary:
		    break;
		case Udelete:
		    DelFrwd (dot, p -> len);
		    break;
		case Uinsert: {
			register    len = p -> len;
			chars -= len;
			if (chars < 0) {
			    InsCStr (UndoCQ, len + chars);
			    len = -chars;
			    chars += NUndoC;
			}
			InsCStr (UndoCQ + chars, len);
		}
		break;
	    default: 
		error ("Something rotten in undo");
		return 0;
	    }
	}

	p--;
	if (p < UndoRQ)
	    p = &UndoRQ[NUndoR - 1];
    }
    LastUndone = p;
    LastUndoneC = chars;
    return 0;
}

InitUndo () {
#ifdef DumpableEmacs
    if (!Once)
#endif
    {
	setkey (CtlXmap, Ctl ('u'), Undo, "undo");
	defproc (UndoBoundary, "undo-boundary");
	defproc (UndoMore, "undo-more");
    }
    DoneIsDone ();
}

version.c       508005729   1094  1000  100644  73        `
/* Current Emacs version */

char version[] = "Emacs #85 of Tue Jul 20";

window.c        512386157   1094  1000  100644  20271     `
/* Window manipulation primitives */

/*		Copyright (c) 1981,1980 James Gosling		*/

/* DJH added substitute Ding() for putchar(07);			*/

#include "config.h"
#include "buffer.h"
#include "keyboard.h"
#include "window.h"
#include "display.h"
#include <stdio.h>
#include <ctype.h>
#include <signal.h>
#include "mlisp.h"

static
struct marker *OneLStart;	/* Starting character position of the line
				   containing dot -- used when doing the
				   one line redisplay optimization. */
static OneLValid;		/* True iff OneLStart points at something
				   valid */
static OneLLine;		/* The display line which contains dot */
static MBLine;			/* The line on which the minibuf starts */
static LineWrapped;		/* True iff the line just dumped has
				   wrapped, this really slows down the the
				   redisplay if it's the current line. */
static QuickRD;			/* True iff quick redisplay alg. is to be
				   used */
static UseTime;			/* A counter used to set the time of last use
				   of a window: for selecting the LRU
				   window */
static GSaveMiniBuf;		/* True iff the cursor is in the minibuf */
static char GlobalModeString[30];	/* The global-mode-string variable */
int PopUpWindows;		/* True iff new windows should be
				   automatically selected by commands that
				   play with other buffers (eg. ^X^V and
				   ^X^B) */
				/* changed from static to int 13-Jan-83
				   so that minibuf.c could use and reset
				   it. - BNI */
static WrapLines;		/* True iff long lines should wrap around */
static ScrollStep;		/* The number of lines to try scrolling a
				   window by when dot leaves the window; if
				   it is <=0 then dot is centered in the
				   window */
static SplitHeightThreshhold;	/* If a window is larger than this it will be
				   considered splitabble when a window is to
				   be popped up (rather than picking the LRU
				   window) */
static MouseX;			/* The X screen coordinate of the mouse */
static MouseY;			/* The Y screen coordinate of the mouse */
static struct window *MouseWin;	/* The window corresponding to
				   (MouseX,MouseY) */
static MouseDot;		/* The character position corresponding to
				   (MouseX,MouseY) */
static Displaying;		/* > 0 when we are refreshing display */
int    QuitDoRstDsp;		/* When set, quit should do a RstDsp */
int    QuitDoQuitMpx;		/* When set, quit should do a QuitMpx */
struct window  *SplitWin ();

/* Move dot to the buffer and character corresponding to some absolute X
   and Y coordinate. */
MoveDotToXY () {
    MouseX = getnum ("X coordinate: ");
    if (!err)
	MouseY = getnum ("Y coordinate: ");
    if (!err) {
	MouseWin = 0;
	Cant1LineOpt++;
	DoDsp (1);
	if (MouseWin == 0)
	    error ("The mouse isn't pointing at a part of a buffer");
	else {
	    SetWin (MouseWin);
	    SetDot (MouseDot);
	}
    }
    return 0;
}

/* Built in time-to-global-mode-string stuff */
static
TimeFreq;

static
TimeHandler()
{
    char   *ctime ();
    long    now = time (0);

    if (TimeFreq) {
	strcpy (GlobalModeString, ctime (&now));
	GlobalModeString[20] = '\0';
    }
    else
	*GlobalModeString = '\0';
    if (!Displaying) {
	char *t = MiniBuf;
	MiniBuf = 0;
	Cant1LineOpt++;
	DoDsp(1);
	MiniBuf = t;
    }
    alarm (TimeFreq);
}

static
ShowTime()
{
    register oldfreq = TimeFreq;

    TimeFreq = getnum (": show-time (frequency) ");
    signal (SIGALRM, TimeHandler);
    if (TimeFreq < 0)
	TimeFreq = 0;
    alarm (TimeFreq);
    MLvalue -> exp_type = IsInteger;
    MLvalue -> exp_int = oldfreq;
    return 0;
}

/* initialize the window system */
InitWin () {
    register struct window *w;
    
#ifdef DumpableEmacs
    if (Once) {			/* Restarting, clean up old junk */
	for (w = windows; w; w = w -> w_next) {
	    DestMark (w -> w_dot);
	    DestMark (w -> w_start);
	    free (w);
	}
    } else
#endif
    {
	PopUpWindows = 1;
	SplitHeightThreshhold = 20;
	OneLStart = NewMark ();
	OneLValid = 0;
	Displaying = 0;
	TimeFreq = 0;
	DefStrVar ("global-mode-string", GlobalModeString);
	DefIntVar ("scroll-step", &ScrollStep);
	DefIntVar ("quick-redisplay", &QuickRD);
	DefIntVar ("wrap-long-lines", &WrapLines);
	DefIntVar ("pop-up-windows", &PopUpWindows);
	DefIntVar ("split-height-threshhold", &SplitHeightThreshhold);
	defproc (MoveDotToXY, "move-dot-to-x-y");
	defproc (ShowTime, "show-time");
    }
    w = (struct window *) malloc (sizeof (struct window));
    windows = w;
    SetDot (1);
    w -> w_height = ScreenLength;
    w -> w_prev = 0;
    w -> w_dot = NewMark ();
    SetMark (w -> w_dot, bf_cur, 1);
    w -> w_start = NewMark ();
    SetMark (w -> w_start, bf_cur, 1);
    w -> w_force = 0;
    w -> w_next = 0;
    w -> w_buf = bf_cur;
    wn_cur = w;
    SetWin (SplitWin (w));
    TieWin (wn_cur, minibuf);
    ChangeWindowSize (1 - wn_cur -> w_height);
    SetWin (w);
}

/* set the current window */
SetWin (w)
struct window  *w; {
    if (w == 0)
	return;
    w -> w_lastuse = UseTime++;
    SetBfp (w -> w_buf);
    wn_cur = w;
    bf_cur = 0;
    Cant1WinOpt++;
    SetBfp (w -> w_buf);
}

struct window  *SplitWin (w)
register struct window *w; {
    register struct window *n;
    register struct buffer *old = bf_cur;
    if (w -> w_height<=4) {
	error ("You can't have windows smaller than two lines high.");
	return w;
    }
    n = (struct window *) malloc (sizeof (struct window));
    n -> w_prev = w;
    n -> w_force = 0;
    n -> w_next = w -> w_next;
    w -> w_next = n;
    if (n -> w_next)
	n -> w_next -> w_prev = n;
    n -> w_height = w -> w_height / 2;
    w -> w_height -= n -> w_height;
    n -> w_dot = NewMark ();
    n -> w_lastuse = 0;
    n -> w_buf = w -> w_buf;
    n -> w_start = NewMark ();
    SetMark (n -> w_dot, n->w_buf, ToMark (w -> w_dot));
    SetMark (n -> w_start, n->w_buf, ToMark (w -> w_start));
    SetBfp (old);
    Cant1WinOpt++;
    return n;
}

/* split the largest window, and return a pointer to it */
struct window *SplitLargestWindow () {
    register struct window *w, *bestw;
    register besth = -1;
    for (w = windows; w -> w_next; w = w->w_next)
	if (w->w_height>besth) besth = w->w_height, bestw = w;
    return SplitWin (bestw);
}

/* Delete the indicated window */
DelWin (w)
register struct window *w; {
    if (w -> w_next == 0)	/* Can't delete the last window -- it's the
				   minibuf */
	return 0;
    if (w -> w_prev) {
	w -> w_prev -> w_height += w -> w_height;
	w -> w_prev -> w_next = w -> w_next;
    }
    else {
	if (w -> w_next -> w_next == 0)
	    return 0;
	windows = w -> w_next;
	windows -> w_height += w -> w_height;
    }
    if (w -> w_next)
	w -> w_next -> w_prev = w -> w_prev;
    if (w == wn_cur)
	SetWin (w -> w_prev ? w -> w_prev : windows);
    DestMark (w->w_dot);
    DestMark (w->w_start);
    Cant1WinOpt++;

    /* I'm not sure if this'll work.  Delete it if it screws up. */
    /* ACT 25 Jun 1983 */
    free (w);

    return 0;
}

/* tie a window to a buffer */
TieWin (w, b)
register struct window *w;
register struct buffer  *b; {
    register newdot;
    if (b == 0 || w == 0 || w -> w_buf == b || b -> b_kind == DeletedBuffer)
	return;
    w -> w_buf = b;
    w -> w_force = 0;
    w -> w_lastuse = UseTime++;
    newdot = b == bf_cur ? dot : b -> b_EphemeralDot;
    SetMark (w -> w_dot, b, newdot);
    SetMark (w -> w_start, b, 1);
}

/* Change the height of the pointed to window by delta; returns true iff
   the change succeeds.  Chains forward if dir>0, backward if dir<0 in
   attempting to find a suitable window. */
ChgWHeight (w, delta, dir)
register struct window *w; {
    while (w)
	if (w -> w_height + delta >= (w -> w_next ? 2 : 1)
		&& (dir == 0 || w -> w_next)) {
	    Cant1WinOpt++;
	    w -> w_height += delta;
	    return 1;
	}
	else
	    w = dir == 0 ? 0 : dir < 0 ? w -> w_prev : w -> w_next;
    return 0;
}

/* find the least recently used window; split if only one window */
struct window  *LRUwin () {
    register struct window *w,
                           *bestw = 0;
    register    youngest = 07777777777;
    register    LargestHeight = 0;
    for (w = windows; w -> w_next; w = w -> w_next) {
	if ((w -> w_buf == bf_cur ? bf_s1 + bf_s2
		    : w -> w_buf -> b_size1 + w -> w_buf -> b_size2) == 0)
	    return w;
	if (w -> w_lastuse < youngest && w != wn_cur) {
	    bestw = w;
	    youngest = w -> w_lastuse;
	}
	if (w -> w_height > LargestHeight)
	    LargestHeight = w -> w_height;
    }
    if (bestw == 0 || LargestHeight >= SplitHeightThreshhold)
	bestw = SplitLargestWindow ();
    return bestw;
}

/* make sure that the current window is on the given buffer, either
   by picking the window that already contains it, the LRU window,
   or some brand new window */
WindowOn (bf)
struct buffer  *bf; {
    register struct window *w;
    if ((w = wn_cur) -> w_buf != bf)
	for (w = windows; w; w = w -> w_next)
	    if (w -> w_buf == bf)
		break;
    if (!w)
	w = (PopUpWindows || wn_cur->w_next == NULL) ? LRUwin () : wn_cur;
    TieWin (w, bf);
    SetWin (w);
}

/* full screen update -- called when absolutely nothing is known or
   many things have been fiddled with */
FullUpd () {
    register struct buffer *keep_bf = bf_cur,
                           *hit_bf = wn_cur -> w_buf;
    register struct window *w = windows;
    register    sline = 1;
    register    hits = 0;
    register    slow = 0;
    while (w) {
	SetBfp (w -> w_buf);
	if (bf_cur == hit_bf)
	    hits++;
	slow |= w -> w_force;
	if ( /* w != wn_cur */ 0)
	    DumpWin (w, sline, 1);
	else {
	    register    ldot;
	    register    dumpstate = 0;
	    if (w != wn_cur)
		ldot = dot, SetDot (ToMark (w -> w_dot));
	    while (dumpstate >= 0 && DumpWin (w, sline, dumpstate == 0)) {
		slow++;
		if (w -> w_force) {
		    SetDot (dumpstate ? ToMark (w -> w_start)
			    : ScanBf ('\n', ToMark (w -> w_start),
				w -> w_height / 2));
		    if (w != wn_cur)
			SetMark (w -> w_dot, w -> w_buf, dot);
		    if (dumpstate++)
			w -> w_force = 0;
		}
		else {
		    register    old,
		                next;
		    switch (dumpstate) {
			case 0: 
			    dumpstate++;
			    if (ScrollStep > 0) {
				old = ToMark (w -> w_start);
				next = ScanBf ('\n', old,
				        old>dot ? -ScrollStep-1 : ScrollStep);
				if (dot >= next)
				    break;
			    }
			case 1: 
			    next = ScanBf ('\n', dot, -(w -> w_height / 2));
			    dumpstate++;
			    break;
			case 2: 
			    next = ScanBf ('\n', (old = ToMark (w -> w_start)), 1);
			    if (old < next && next <= dot)
				break;
			default: 
			    dumpstate++;
			    next = ToMark (w -> w_start) + 50;
			    if (dumpstate > 10)
				dumpstate = -1;
			case -1: 
			    break;
		    }
		    if (next <= dot)
			SetMark (w -> w_start, w -> w_buf, next);
		    else
			dumpstate = -1;
		}
	    }
	    if (w != wn_cur)
		SetDot (ldot);
	    w -> w_force = 0;
	}
	sline += w -> w_height;
	if (RedoModes && w -> w_next)
	    DumpMode (w, sline - 1);
	w = w -> w_next;
    }
    CantEverOpt = hits > 1 && !QuickRD;
    SetBfp (keep_bf);
    return slow;
}

/* Dump the mode line for window w on line n -- assumes the current buffer
   is the one associated with window w */
DumpMode (w, l)
register struct window *w; {
    char    buf[300],
            tbuf[20];
    register char  *p = buf;
    register char  *s = bf_mode.md_ModeFormat;
    register char  *str;
    register char   c;
    int     width;
/* ACT 17-Oct-1982 Added '-' format */
    int     negative = 0;
#define ModeC(c) if (p>buf+(sizeof buf)-2) goto out; else *p++ = c;

    while (c = *s++)
	if (c == '%') {
	    str = 0;
	    width = 0;
	    if (*s == '-') {
		++negative;
		++s;
	    }
	    while (isdigit (c = *s++))
		width = width * 10 + (c - '0');
	    switch (c) {
		case 0: 
		    goto out;
		default: 
		    ModeC (c);
		    break;
		case 'b': 
		    str = bf_cur -> b_name;
		    break;
		case 'f': 
		    if ((str = bf_cur -> b_fname) == 0)
			str = "[None]";
		    break;
		case 'F':	/* ACT 17-Oct-1982 */
		    if ((str = bf_cur -> b_fname) == 0)
			str = "[None]";
		    else {
			register char *str1 = str;
			while (*str1)
				if (*str1++ == DIRDELIMC && *str1) str = str1;
		    }
		    break;
		case 'm': 
		    str = bf_mode.md_ModeString;
		    break;
		case 'a':	/* ACT 19-Aug-1983 */
		    str = bf_mode.md_AbbrevOn ? "abbrev" : "";
		    break;
		case 'M': 
		    str = GlobalModeString;
		    break;
		case '*': 
		    str = bf_modified ? "*" : "";
		    break;
		case 'p': {
			int     tl = bf_s1 + bf_s2,
			        d;
			d = w == wn_cur ? dot : ToMark (w -> w_dot);
			if (d <= 1)
			    str = "Top";
			else
			    if (d > tl)
				str = "Bottom";
			    else {
				sprintf (tbuf, "%2d%%", (d - 1) * 100 / tl);
				str = tbuf;
			    }
			break;
		    }
		case 'D':	/* ACT 25 Jun 1983 */
		    sprintf (tbuf, "%d", RecurseDepth - MinibufDepth);
		    str = tbuf;
		    break;
		case '[': 
			str = RecurseDepth-MinibufDepth > 10
					? "*["
					: ("[[[[[[[[[[" + 10)
						- (RecurseDepth-MinibufDepth);
		    break;
		case ']': 
			str = RecurseDepth-MinibufDepth > 10
					? "*]"
					: ("]]]]]]]]]]" + 10)
						- (RecurseDepth-MinibufDepth);
		    break;
	    }
	    if (str) {
		if (negative && width) {
		    if ((negative = strlen (str)) > width)
			str += negative - width;
		    else {
			while (width > negative) {
			    width--;
			    ModeC (' ');
			}
		    }
		}
		while (*str) {
		    ModeC (*str++);
		    if (--width == 0)
			break;
		}
		while (--width >= 0)
		    ModeC (' ');
	    }
	}
	else
	    ModeC (c);
out: 
    *p++ = 0;
    DumpStr (buf, 300, l, 1);
}

/* dump the indicated string (with maximum length n) to line l */
DumpStr (s, n, l, highlight)
register char  *s; {
    register    col = 1;
    register    setcurs = s == MiniBuf && InMiniBuf;
    setpos (l, col);
    if (highlight)
	HighLine ();
    while (--n >= 0) {
	register char   c = *s++;
	if (c == 0)
	    break;
	if (c == 011 && bf_mode.md_TabSize >= 1) {
	    col = ((col - 1) / bf_mode.md_TabSize + 1)
				* bf_mode.md_TabSize + 1;
	    if (col <= ScreenWidth)
		setpos (l, col);
	}
	else
	    if (c < 040 || c >= 0177)
		if (CtlArrow && (c & 0200) == 0) {
		    col += 2;
		    if (col <= ScreenWidth + 1) {
			dsputc ('^');
			dsputc (c < 040 ? (c & 037) + 0100 : '?');
		    }
		}
		else {
		    col += 4;
		    if (col <= ScreenWidth + 1) {
			dsputc ('\\');
			dsputc (((c >> 6) & 3) + '0');
			dsputc (((c >> 3) & 7) + '0');
			dsputc ((c & 7) + '0');
		    }
		}
	    else {
		col++;
		if (col <= ScreenWidth + 1)
		    dsputc (c);
	    }
    }
    if (col > ScreenWidth + 1) {
	setpos (l, ScreenWidth);
	dsputc ('$');
    }
    if (setcurs) {
	cursY = l;
	cursX = col > ScreenWidth ? ScreenWidth : col;
    }
}

/* dump one line from the current buffer starting at character n onto
   line l; setting cursX and cursY if appropriate */
DumpBfl (n, l, w)
register struct window *w;
register    n; {
    register    col = ScreenWidth + 1 - left;
    register    lim = NumCharacters;
    int     misseddot = 1;
    register char   c;
    while (1) {
	if (n == dot) {
	    if (w == wn_cur && (!GSaveMiniBuf || !InMiniBuf)) {
		cursX = col;
		cursY = l;
		DotCol = col;
		ColValid++;
		if (cursX > ScreenWidth )
		    cursX = ScreenWidth;
	    }
	    misseddot = 0;
	}
	if (n > lim) {
	    n++;
	    c = '\n';
	    break;
	}
	if (MouseY == l && MouseX<col && MouseWin==0) {
	    MouseWin = w;
	    MouseDot = n-1;
	}
	c = CharAt (n);
	n++;
	if (c == '\n')
	    break;
	if (c == 011 && bf_mode.md_TabSize >= 1) {
	    col = ((col - 1) / bf_mode.md_TabSize + 1)
				* bf_mode.md_TabSize + 1;
	    if (col < ScreenWidth + 1)
		setpos (l, col);
	    else
		if (WrapLines) {
		    n--;
		    break;
		}
	}
	else
	    if (c < 040 || c >= 0177)
		if (CtlArrow && (c & 0200) == 0) {
		    col += 2;
		    if (col <= ScreenWidth + 1) {
			dsputc ('^');
			dsputc (c < 040 ? (c & 037) + 0100 : '?');
		    }
		    else
			if (WrapLines) {
			    n--;
			    break;
			}
		}
		else {
		    col += 4;
		    if (col <= ScreenWidth + 1) {
			dsputc ('\\');
			dsputc (((c >> 6) & 3) + '0');
			dsputc (((c >> 3) & 7) + '0');
			dsputc ((c & 7) + '0');
		    }
		    else
			if (WrapLines) {
			    n--;
			    break;
			}
		}
	    else {
		col++;
		if (col <= ScreenWidth + 1)
		    dsputc (c);
		else
		    if (WrapLines) {
			n--;
			break;
		    }
	    }
    }
    if (MouseY == l && MouseWin==0) {
	MouseWin = w;
	MouseDot = n-1;
    }
    LineWrapped = 0;
    if (col > ScreenWidth + 1 || c != '\n') {
	setpos (l, ScreenWidth);
	dsputc (WrapLines ? '\\' : '$');
	if (WrapLines)
	    n--, LineWrapped++;
    }
    return misseddot ? n : -n;
}

/* dump the text from the indicated window on the indicated line;
   the current buffer must be the one tied to this window */
DumpWin (Window, Line, CanMove)
register struct window *Window;
register    Line; {
    register    left = Window -> w_next ? Window -> w_height - 1
    :           Window -> w_height;
    register    n = ToMark (Window -> w_start);
    int     misseddot = 1;
    int     DoClear = 0;
    if (CanMove && ((n > FirstCharacter && CharAt (n - 1) != '\n')
		|| n < FirstCharacter)) {
	n = n < FirstCharacter ? FirstCharacter : ScanBf ('\n', n, -1);
	SetMark (Window -> w_start, Window -> w_buf, n);
    }
    if (Window -> w_next == 0) {
	MBLine = Line;
	if (GSaveMiniBuf && MiniBuf == 0)
	    return 0;
	clearline (Line);
	if (MiniBuf) {
	    if (n == 1)
		DumpStr (MiniBuf, 300, Line, 0);
	    if (*MiniBuf == 0) {
		while (--left > 0)
		    clearline (++Line);
		return 0;
	    }
	}
    }
    else
	clearline (Line);
    while (--left >= 0) {
	register    next;
	if (DoClear)
	    clearline (Line);
	DoClear++;
	next = DumpBfl (n, Line++, Window);
	if (next < 0) {
	    if (Window == wn_cur) {
		SetMark (OneLStart, bf_cur, LineWrapped ? 1 : n);
		OneLValid = !LineWrapped;
		OneLLine = Line - 1;
	    }
	    next = -next;
	    misseddot = 0;
	}
	n = next;
    }
    return misseddot;
}

/* Leave emacs after (optionally) spitting some expletive on the tty */
/* VARARGS 1 */
quit (code, fmt, args) char *fmt; {
    if (TimeFreq)
	alarm (0);
#ifdef subprocesses
    kill_processes ();
#endif
#ifndef apm
    if (QuitDoQuitMpx)
	QuitMpx ();
#endif
    if (QuitDoRstDsp)
	RstDsp ();
    if (fmt)
	_doprnt (fmt, &args, stderr);
#ifdef OneEmacsPerTty
    UnlockTty ();
#endif
    exit (code);
}

/* Scan the current buffer for the k'th occurrence of character c,
   starting at position n; k may be negative.  Returns the position
   of the character following the one found */
ScanBf (c, n, k)
char    c;
register    n; {
    while (k)
	if (k > 0) {
	    do {
		if (n > NumCharacters)
		    return n;
		if (CharAt (n) == c)
		    break;
		n++;
	    } while (1);
	    if(--k) n++;
	}
	else {
	    do {
		n--;
		if (n < FirstCharacter)
		    return FirstCharacter;
		if (CharAt (n) == c)
		    break;
	    } while (1);
	    k++;
	}
    return n + 1;
}

#define CURmode(n)	{ if (tt.t_CURmode) tt.t_CURmode(n); }

/* do a screen update, taking possible shortcuts into account */
DoDsp (SaveMiniBuf) {
    register    SlowUpdate = 0;
    register    DoneMiniBuf = 0;

    Displaying++;
    CURmode (0);	/* disable cursor */
    GSaveMiniBuf = SaveMiniBuf;
    if (ScreenGarbaged || err || (LastRedisplayPaused && !InMiniBuf))
	Cant1WinOpt++, DumpMiniBuf++, LastRedisplayPaused = 0;
    if (Cant1WinOpt)
	Cant1LineOpt++, RedoModes++;
    if (!Cant1LineOpt && OneLValid && !OneLStart -> m_modified
	    && OneLStart -> m_buf == bf_cur) {
	register    n = ToMark (OneLStart);
	clearline (OneLLine);
	if (MiniBuf && wn_cur -> w_next == 0) {
	    if (n == 1)
		DumpStr (MiniBuf, 300, OneLLine, 0);
	    DoneMiniBuf++;
	}
	if (DumpBfl (n, OneLLine, wn_cur) < 0 && !LineWrapped)
	    goto update;	/* we made it ! */
	else
	    if (!WrapLines)
		SlowUpdate = -1;
    }
    DoneMiniBuf++;
    SlowUpdate++;
    OneLValid = 0;
    if (FullUpd ())
	SlowUpdate = 1;
update:
    if (MiniBuf && (!GSaveMiniBuf || *MiniBuf)) {
	if (!DoneMiniBuf) {
	    clearline (MBLine);
	    DumpStr (MiniBuf, 300, MBLine, 0);
	}
	if (ResetMiniBuf) {
	    MiniBuf = ResetMiniBuf;
	    if (*ResetMiniBuf == 0) ResetMiniBuf = 0;
	}
	else
	    MiniBuf = *MiniBuf ? "" : 0;
    }
    UpdateScreen (SlowUpdate);
    if (err) {
	Ding ();
	err = 0;
    }
    Cant1LineOpt = 0;
    Cant1WinOpt = CantEverOpt;
    CURmode (1);	/* enable cursor */
    fflush (stdout);
    Displaying--;
}

windowman.c     508005730   1094  1000  100644  6359      `
/* window management commands */

/*		Copyright (c) 1981,1980 James Gosling		*/

/* Modified 7-Dec-80 DJH	Implement ^x^o command	*/
/* ACT 17-Oct-1982		Implement rename-buffer */

#include "window.h"
#include "buffer.h"
#include "keyboard.h"

ListBuffers () {
    register struct buffer *old = bf_cur,
                           *p;
    SetBfn ("Buffer list");
    if(interactive) WindowOn (bf_cur);
    WidenRegion ();
    EraseBf (bf_cur);
    InsStr ("\
   Size  Type   Buffer         Mode           File\n\
   ----  ----   ------         ----           ----\n");
    for (p = buffers; p; p = p -> b_next) {
	char    line[300];
	sprintfl (line, sizeof line, "%7d%6s %c %-14s %-14s %s\n",
		p -> b_size1 + p -> b_size2,
		p -> b_kind == FileBuffer ? "File"
		: p -> b_kind == MacroBuffer ? "Macro"
		: "Scr",
		p -> b_modified ? 'M' : ' ',
		p -> b_name,
		p -> b_mode.md_ModeString,
		p -> b_fname ? p -> b_fname : "");
	InsStr (line);
    }
    bf_modified = 0;
    bf_cur -> b_mode.md_NeedsCheckpointing = 0;
    SetDot (1);
    SetBfp (old);
    WindowOn (bf_cur);
    return 0;
}

DeleteOtherWindows () {
    register struct window *w = windows;
    while (w) {
	if (w != wn_cur)
	    DelWin (w);
	w = w -> w_next;
    }
    return 0;
}

SplitCurrentWindow () {
    SetWin (SplitWin (wn_cur));
    return 0;
}

static
SwitchToBuffer () {
    SetBfn (getnbstr ("Buffer: "));
    TieWin (wn_cur->w_next ? wn_cur : windows, bf_cur);
    return 0;
}

static
PopToBuffer () {
    SetBfn (getnbstr (": pop-to-buffer "));
    WindowOn (bf_cur);
    return 0;
}

static
TempUseBuffer () {
    SetBfn (getnbstr (": temp-use-buffer "));
    return 0;
}

EraseBuffer () {
    EraseBf (bf_cur);
    return 0;
}

/* DJH 7-Dec-80	This routine prompts for a buffer name with
		command completion.
 */
UseOldBuffer () {
    register int    bfn = getword (BufNames, "Buffer: ");
    if (bfn >= 0) {
	SetBfn (BufNames[bfn]);
	TieWin (wn_cur->w_next ? wn_cur : windows, bf_cur);
    }
    return 0;
}

RenameBuffer () {
    register bfn = getword (BufNames, ": rename-buffer ");
    register struct buffer *b;
    if (bfn >= 0 && (b = FindBf (BufNames[bfn]))) {
	if (b == minibuf) error ("Can't rename MiniBuf");
	else {
	    register char *s = getstr(": rename-buffer %s to ", BufNames[bfn]);
	    if (s) RenameBf (b, s);
	}
    }
    return 0;
}

DeleteBuffer () {
    register int    bfn = getword (BufNames, ": delete-buffer ");
    register struct buffer *b;
    register char *reply;
    if (bfn < 0 || (b = FindBf (BufNames[bfn])) == 0 || b == minibuf)
	return 0;
    if (interactive && b -> b_kind != ScratchBuffer
	    && (b == bf_cur	? bf_modified
				: b -> b_modified) > 0
	    && ((reply = getstr (": delete-buffer %s; are you sure? ",
			BufNames[bfn])) == 0
		|| *reply != 'y'))
	return 0;
    DelBuf (b);
    return 0;
}

DeleteWindow () {
    DelWin (wn_cur);
    SetBfp (wn_cur -> w_buf);
    return 0;
}

NextWindow () {
    SetWin (wn_cur -> w_next ? wn_cur -> w_next : windows);
    if (wn_cur->w_next==0 && ResetMiniBuf==0) NextWindow ();
    return 0;
}

PreviousWindow () {
    register struct window *w = wn_cur -> w_prev;
    if (w == 0) {
	w = windows;
	while (w -> w_next)
	    w = w -> w_next;
    }
    SetWin (w);
    if (wn_cur->w_next==0 && ResetMiniBuf==0) PreviousWindow ();
    return 0;
}

ShrinkWindow () {
    ChangeWindowSize (-arg);
}

static
EnlargeWindow () {
    ChangeWindowSize (arg);
}

ChangeWindowSize (delta)
register    delta; {
    if (wn_cur -> w_height + delta < (wn_cur->w_buf == minibuf ? 1 : 2)
	    || (!ChgWHeight (wn_cur -> w_next, -delta, 1)
		&& !ChgWHeight (wn_cur -> w_prev, -delta, -1)))
	error ("Can't change window size");
    else
	if (!ChgWHeight (wn_cur, delta, 0))
	    error ("Emacs bug -- window size change.");
    return 0;
}

static
WindowMove (w,down,lots,dottop)		/* handles ^Z, $Z, ^V, $V and $! */
register struct window *w; {
    register    n = arg;
    register    pos;
    if (n < 0) {
	down = !down;
	n = -n;
    }
    if (lots)
	n *= w -> w_height * 4 / 5;
    if (down)
	n = -n - 1;
    if (dottop) {
	n = -1;
	pos = dot;
    }
    else
	pos = ToMark (w -> w_start);
    SetMark (w -> w_start, w -> w_buf,
	    ScanBf ('\n', pos, n));
    w -> w_force++;
    Cant1LineOpt++;
}

static ScrollOneLineUp () {
    WindowMove (wn_cur, 0, 0, 0);
    return 0;
}

static ScrollOneLineDown () {
    WindowMove (wn_cur, 1, 0, 0);
    return 0;
}

static NextPage () {
    WindowMove (wn_cur, 0, 1, 0);
    return 0;
}

static PreviousPage () {
    WindowMove (wn_cur, 1, 1, 0);
    return 0;
}

static LineToTopOfWindow () {
    WindowMove (wn_cur, 0, 0, 1);
    return 0;
}

static  PageNextWindow () {
    struct window  *w = wn_cur -> w_next;
    register down = ArgState==HaveArg;
    arg = 1;
    if (w == 0 || w -> w_next == 0 && ResetMiniBuf == 0)
	w = windows;
    if (w == wn_cur)
/*	error ("There is no other window, twit!"); */
	error ("There is no other window");
    else {
	SetBfp (w -> w_buf);
	WindowMove (w, down, 1, 0);
	SetBfp (wn_cur -> w_buf);
    }
    return 0;
}

InitWnMan () {
#ifdef DumpableEmacs
    if (!Once)
#endif
    {
	setkey (CtlXmap, (Ctl ('B')), ListBuffers, "list-buffers");
	setkey (CtlXmap, ('2'), SplitCurrentWindow, "split-current-window");
	setkey (CtlXmap, ('1'), DeleteOtherWindows, "delete-other-windows");
	setkey (CtlXmap, ('b'), SwitchToBuffer, "switch-to-buffer");
	defproc (PopToBuffer, "pop-to-buffer");
	defproc (DeleteBuffer, "delete-buffer");
	defproc (TempUseBuffer, "temp-use-buffer");
	defproc (EraseBuffer, "erase-buffer");
	defproc (RenameBuffer, "rename-buffer");
	setkey (CtlXmap, (Ctl ('O')), UseOldBuffer, "use-old-buffer");    /* DJH */
	setkey (CtlXmap, ('d'), DeleteWindow, "delete-window");
	setkey (CtlXmap, ('n'), NextWindow, "next-window");
	setkey (CtlXmap, ('p'), PreviousWindow, "previous-window");
	setkey (CtlXmap, ('z'), EnlargeWindow, "enlarge-window");
	setkey (CtlXmap, (Ctl ('Z')), ShrinkWindow, "shrink-window");
	setkey (GlobalMap, (Ctl ('Z')), ScrollOneLineUp, "scroll-one-line-up");
	setkey (ESCmap, (Ctl ('V')), PageNextWindow, "page-next-window");
	setkey (ESCmap, ('z'), ScrollOneLineDown, "scroll-one-line-down");
	setkey (GlobalMap, (Ctl ('V')), NextPage, "next-page");
	setkey (ESCmap, ('v'), PreviousPage, "previous-page");
	setkey (ESCmap, ('!'), LineToTopOfWindow, "line-to-top-of-window");
    }
}