Initial revision

33 files changed, 7240 insertions, 0 deletions

diff --git a/lib-src/emacstool.c b/lib-src/emacstool.c
new file mode 100644
index 0000000000..5e310e0faa
--- /dev/null
+++ b/lib-src/emacstool.c
@@ -0,0 +1,340 @@
+/*
+ * 
+ *    Copyright (C) 1986 Free Software Foundation, Inc.
+ * 
+ * This file is part of GNU Emacs.
+
+GNU Emacs is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 1, or (at your option)
+any later version.
+
+GNU Emacs is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Emacs; see the file COPYING.  If not, write to
+the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
+ * 
+ *
+ * For Emacs in SunView/Sun-Windows: (supported by Sun Unix v3.2)
+ * Insert a notifier filter-function to convert all useful input 
+ * to "key" sequences that emacs can understand.  See: Emacstool(1).
+ *
+ * Author: Jeff Peck, Sun Microsystems, Inc. <peck@sun.com>
+ *
+ * Original Idea: Ian Batten
+ * Updated 15-Mar-88, Jeff Peck: set IN_EMACSTOOL, TERM, TERMCAP
+ * 
+ */
+
+#include <suntool/sunview.h>
+#include <suntool/tty.h>
+#include <stdio.h>
+#include <sys/file.h>
+
+#define BUFFER_SIZE 128               /* Size of all the buffers */
+
+/* define WANT_CAPS_LOCK to make f-key T1 (aka F1) behave as CapsLock */
+#define WANT_CAPS_LOCK
+#ifdef WANT_CAPS_LOCK
+int caps_lock;		/* toggle indicater for f-key T1 caps lock */
+static char *Caps = "[CAPS] ";		/* Caps Lock prefix string */
+#define CAPS_LEN 7			/* strlen (Caps) */
+#endif
+
+static char *mouse_prefix = "\030\000";	/* C-x C-@ */
+static int   m_prefix_length = 2;       /* mouse_prefix length */
+
+static char *key_prefix = "\030*";  	/* C-x *   */
+static int   k_prefix_length = 2;       /* key_prefix length */
+
+static char *emacs_name = "emacs";	/* default run command */
+static char buffer[BUFFER_SIZE];	/* send to ttysw_input */
+static char *title = "Emacstool - ";	/* initial title */
+
+Frame frame;                            /* Base frame for system */
+Tty ttysw;                              /* Where emacs is */
+int font_width, font_height;            /* For translating pixels to chars */
+
+int console_fd = 0;		/* for debugging: setenv DEBUGEMACSTOOL */
+FILE *console;			/* for debugging: setenv DEBUGEMACSTOOL */
+
+Icon frame_icon;
+/* make an icon_image for the default frame_icon */
+static short default_image[258] = 
+{
+#include <images/terminal.icon>
+};
+mpr_static(icon_image, 64, 64, 1, default_image);
+
+
+/*
+ * Assign a value to a set of keys
+ */
+int
+button_value (event)
+     Event *event;
+{
+  int retval = 0;
+  /*
+   * Code up the current situation:
+   *
+   * 1 = MS_LEFT;
+   * 2 = MS_MIDDLE;
+   * 4 = MS_RIGHT;
+   * 8 = SHIFT;
+   * 16 = CONTROL;
+   * 32 = META;
+   * 64 = DOUBLE;
+   * 128 = UP;
+   */
+
+  if (MS_LEFT   == (event_id (event))) retval = 1;
+  if (MS_MIDDLE == (event_id (event))) retval = 2;
+  if (MS_RIGHT  == (event_id (event))) retval = 4;
+
+  if (event_shift_is_down (event)) retval += 8;
+  if (event_ctrl_is_down  (event)) retval += 16;
+  if (event_meta_is_down  (event)) retval += 32;
+  if (event_is_up         (event)) retval += 128;
+  return retval;
+}
+
+/*
+ *  Variables to store the time of the previous mouse event that was
+ *  sent to emacs.
+ *
+ *  The theory is that to time double clicks while ignoreing UP buttons,
+ *  we must keep track of the accumulated time.
+ *
+ *  If someone writes a SUN-SET-INPUT-MASK for emacstool,
+ *  That could be used to selectively disable UP events, 
+ *  and then this cruft wouldn't be necessary.
+ */
+static long prev_event_sec = 0;
+static long prev_event_usec = 0;
+
+/*
+ *  Give the time difference in milliseconds, where one second
+ *  is considered infinite.
+ */
+int
+time_delta (now_sec, now_usec, prev_sec, prev_usec)
+     long now_sec, now_usec, prev_sec, prev_usec;
+{
+  long sec_delta = now_sec - prev_sec;
+  long usec_delta = now_usec - prev_usec;
+  
+  if (usec_delta < 0) {		/* "borrow" a second */
+    usec_delta += 1000000;
+    --sec_delta;
+  }
+  
+  if (sec_delta >= 10) 
+    return (9999);		/* Infinity */
+  else
+    return ((sec_delta * 1000) + (usec_delta / 1000));
+}
+
+
+/*
+ * Filter function to translate selected input events for emacs
+ * Mouse button events become ^X^@(button x-col y-line time-delta) .
+ * Function keys: ESC-*{c}{lrt} l,r,t for Left, Right, Top; 
+ * {c} encodes the keynumber as a character [a-o]
+ */
+static Notify_value
+input_event_filter_function (window, event, arg, type)
+     Window window;
+     Event *event;
+     Notify_arg arg;
+     Notify_event_type type;
+{
+  struct timeval time_stamp;
+
+  if (console_fd) fprintf(console, "Event: %d\n", event_id(event));
+
+  /* UP L1 is the STOP key */
+  if (event_id(event) == WIN_STOP) {
+    ttysw_input(ttysw, "\007\007\007\007\007\007\007", 7);
+    return NOTIFY_IGNORED;
+  }
+
+  /* UP L5 & L7 is Expose & Open, let them pass to sunview */
+  if (event_id(event) == KEY_LEFT(5) || event_id(event) == KEY_LEFT(7))
+    if(event_is_up (event)) 
+      return notify_next_event_func (window, event, arg, type);
+    else return NOTIFY_IGNORED;
+
+  if (event_is_button (event)) { 	      /* do Mouse Button events */
+/* Commented out so that we send mouse up events too.
+   if (event_is_up (event)) 
+      return notify_next_event_func (window, event, arg, type);
+*/
+    time_stamp = event_time (event);
+    ttysw_input (ttysw, mouse_prefix, m_prefix_length);
+    sprintf (buffer, "(%d %d %d %d)\015", 
+	     button_value (event),
+	     event_x (event) / font_width,
+	     event_y (event) / font_height,
+	     time_delta (time_stamp.tv_sec, time_stamp.tv_usec,
+			 prev_event_sec, prev_event_usec)
+	     );
+    ttysw_input (ttysw, buffer, strlen(buffer));
+    prev_event_sec = time_stamp.tv_sec;
+    prev_event_usec = time_stamp.tv_usec;
+    return NOTIFY_IGNORED;
+  }
+  
+  { /* Do the function key events */
+    int d;
+    char c = (char) 0;
+    if ((event_is_key_left  (event)) ?
+	((d = event_id(event) - KEY_LEFT(1)   + 'a'), c='l') : 
+	((event_is_key_right (event)) ?
+	 ((d = event_id(event) - KEY_RIGHT(1) + 'a'), c='r') : 
+	 ((event_is_key_top   (event)) ?
+	  ((d = event_id(event) - KEY_TOP(1)  + 'a'), c='t') : 0)))
+      {
+	if (event_is_up(event)) return NOTIFY_IGNORED;
+	if (event_shift_is_down (event)) c = c -  32;
+	/* this will give a non-{lrt} for unshifted keys */
+	if (event_ctrl_is_down  (event)) c = c -  64;
+	if (event_meta_is_down  (event)) c = c + 128;
+#ifdef WANT_CAPS_LOCK
+/* set a toggle and relabel window so T1 can act like caps-lock */
+	if (event_id(event) == KEY_TOP(1)) 
+	  {
+	    /* make a frame label with and without CAPS */
+	    strcpy (buffer, Caps); 
+	    title = &buffer[CAPS_LEN];
+	    strncpy (title, (char *)window_get (frame, FRAME_LABEL),
+		     BUFFER_SIZE - CAPS_LEN);
+	    buffer[BUFFER_SIZE] = (char) 0;	
+	    if (strncmp (title, Caps, CAPS_LEN) == 0)
+	      title += CAPS_LEN; 		 /* already Caps */
+	    caps_lock =  (caps_lock ? 0 : CAPS_LEN);
+	    window_set(frame, FRAME_LABEL, (title -= caps_lock), 0);
+	    return NOTIFY_IGNORED;
+	  }
+#endif
+	ttysw_input (ttysw, key_prefix, k_prefix_length);
+	sprintf (buffer, "%c%c", d, c);
+	ttysw_input(ttysw, buffer, strlen(buffer));
+
+	return NOTIFY_IGNORED;
+      }
+  }
+  if ((event_is_ascii(event) || event_is_meta(event)) 
+      && event_is_up(event)) return NOTIFY_IGNORED;
+#ifdef WANT_CAPS_LOCK
+/* shift alpha chars to upper case if toggle is set */
+  if ((caps_lock) && event_is_ascii(event)
+      && (event_id(event) >= 'a') && (event_id(event) <= 'z'))
+    event_set_id(event, (event_id(event) - 32));
+/* crufty, but it works for now. is there an UPCASE(event)? */
+#endif
+  return notify_next_event_func (window, event, arg, type);
+}
+
+main (argc, argv)
+     int argc;
+     char **argv;
+{
+  int error_code;	/* Error codes */
+  
+  if(getenv("DEBUGEMACSTOOL"))
+    console = fdopen (console_fd = open("/dev/console",O_WRONLY), "w");
+
+  			/* do this first, so arglist can override it */
+  frame_icon = icon_create (ICON_LABEL, "Emacstool",
+			    ICON_IMAGE, &icon_image,
+			    0);
+
+  putenv("IN_EMACSTOOL=t");	/* notify subprocess that it is in emacstool */
+
+  if (putenv("TERM=sun") != 0)	/* TTYSW will be a TERM=sun window */
+    {fprintf (stderr, "%s: Could not set TERM=sun, using `%s'\n",
+	     argv[0], (char *)getenv("TERM")) ;};
+  /*
+   * If TERMCAP starts with a slash, it is the pathname of the
+   * termcap file, not an entry extracted from it, so KEEP it!
+   * Otherwise, it may not relate to the new TERM, so Nuke-It.
+   * If there is no TERMCAP environment variable, don't make one.
+   */
+  {
+    char *termcap ;	/* Current TERMCAP value */
+    termcap = (char *)getenv("TERMCAP") ;
+    if (termcap && (*termcap != '/'))
+      {
+	if (putenv("TERMCAP=") != 0)
+	  {fprintf (stderr, "%s: Could not clear TERMCAP\n", argv[0]) ;} ;
+      } ;
+  } ;
+  
+  /* find command to run as subprocess in window */
+  if (!(argv[0] = (char *)getenv("EMACSTOOL")))	/* Set emacs command name */
+      argv[0] = emacs_name;			
+  for (argc = 1; argv[argc]; argc++)		/* Use last one on line */
+    if(!(strcmp ("-rc", argv[argc])))		/* Override if -rc given */
+      {
+	int i = argc;
+	argv[argc--]=0;		/* kill the -rc argument */
+	if (argv[i+1]) {	/* move to agrv[0] and squeeze the rest */
+	  argv[0]=argv[i+1];
+	  for (; argv[i+2]; (argv[i]=argv[i+2],argv[++i]=0));
+	}
+      }
+
+  strcpy (buffer, title);
+  strncat (buffer, argv[0],		 /* append run command name */
+	   (BUFFER_SIZE - (strlen (buffer)) - (strlen (argv[0]))) - 1);
+
+  			/* Build a frame to run in */
+  frame = window_create ((Window)NULL, FRAME,
+			 FRAME_LABEL, buffer,
+			 FRAME_ICON, frame_icon,
+			 FRAME_ARGC_PTR_ARGV, &argc, argv,
+			 0);
+
+  /* Create a tty with emacs in it */
+  ttysw = window_create (frame, TTY, 
+			 TTY_QUIT_ON_CHILD_DEATH, TRUE, 
+			 TTY_BOLDSTYLE, 8, 
+			 TTY_ARGV, argv, 
+			 0);
+
+  window_set(ttysw,
+	     WIN_CONSUME_PICK_EVENTS, 
+	     WIN_STOP,
+	     WIN_MOUSE_BUTTONS, WIN_UP_EVENTS,
+	     /* LOC_WINENTER, LOC_WINEXIT, LOC_MOVE, */
+	     0,
+
+	     WIN_CONSUME_KBD_EVENTS, 
+	     WIN_STOP,
+	     WIN_ASCII_EVENTS, 
+	     WIN_LEFT_KEYS, WIN_TOP_KEYS, WIN_RIGHT_KEYS,
+	     /* WIN_UP_ASCII_EVENTS, */
+	     0,
+	     
+	     0);
+
+  font_height = (int)window_get (ttysw, WIN_ROW_HEIGHT);
+  font_width  = (int)window_get (ttysw, WIN_COLUMN_WIDTH);
+
+                                         /* Interpose my event function */
+  error_code = (int)  notify_interpose_event_func 
+    (ttysw, input_event_filter_function, NOTIFY_SAFE);
+
+  if (error_code != 0)                       /* Barf */
+    {
+      fprintf (stderr, "notify_interpose_event_func got %d.\n", error_code);
+      exit (1);
+    }
+
+  window_main_loop (frame);                  /* And away we go */
+}
diff --git a/lisp/case-table.el b/lisp/case-table.el
new file mode 100644
index 0000000000..f10580fe57
--- /dev/null
+++ b/lisp/case-table.el
@@ -0,0 +1,101 @@
+;; Functions for extending the character set and dealing with case tables.
+;; Copyright (C) 1988 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+;; Written by:
+;; TN/ETX/TX/UMG Howard Gayle        UUCP : seismo!enea!erix!howard
+;; Telefonaktiebolaget L M Ericsson  Phone: +46 8 719 55 65
+;; Ericsson Telecom     	     Telex: 14910 ERIC S
+;; S-126 25 Stockholm                FAX  : +46 8 719 64 82
+;; Sweden
+
+(defun describe-buffer-case-table ()
+  "Describe the case table of the current buffer."
+  (interactive)
+  (let ((vector (make-vector 256 nil))
+	(case-table (current-case-table))
+	(i 0))
+    (while (< i 256)
+      (aset vector i 
+	    (cond ((/= ch (downcase ch))
+		   (concat "uppercase, matches "
+			   (text-char-description (downcase ch))))
+		  ((/= ch (upcase ch))
+		   (concat "lowercase, matches "
+			   (text-char-description (upcase ch))))
+		  (t "case-invariant")))
+      (setq i (1+ i))))
+  (with-output-to-temp-buffer "*Help*"
+    (describe-vector vector)))
+
+(defun invert-case (count)
+  "Change the case of the character just after point and move over it.
+With arg, applies to that many chars.
+Negative arg inverts characters before point but does not move."
+  (interactive "p")
+  (if (< count 0)
+      (progn (setq count (min (1- (point)) (- count)))
+	     (forward-char (- count))))
+  (while (> count 0)
+    (let ((oc (following-char)))		; Old character.
+      (cond ((/= (upcase ch) ch)
+	     (replace-char (upcase ch)))
+	    ((/= (downcase ch) ch)
+	     (replace-char (downcase ch)))))
+    (forward-char 1)
+    (setq count (1- count))))
+
+(defun set-case-syntax-delims (l r table)
+  "Make characters L and R a matching pair of non-case-converting delimiters.
+Sets the entries for L and R in standard-case-table,
+standard-syntax-table, and text-mode-syntax-table to indicate
+left and right delimiters."
+  (aset (car table) l l)
+  (aset (car table) r r)
+  (modify-syntax-entry l (concat "(" (char-to-string r) "  ")
+		       (standard-syntax-table))
+  (modify-syntax-entry l (concat "(" (char-to-string r) "  ")
+		       text-mode-syntax-table)
+  (modify-syntax-entry r (concat ")" (char-to-string l) "  ")
+		       (standard-syntax-table))
+  (modify-syntax-entry r (concat ")" (char-to-string l) "  ")
+		       text-mode-syntax-table))
+
+(defun set-case-syntax-pair (uc lc table)
+  "Make characters UC and LC a pair of inter-case-converting letters.
+Sets the entries for characters UC and LC in
+standard-case-table, standard-syntax-table, and
+text-mode-syntax-table to indicate an (uppercase, lowercase)
+pair of letters."
+  (aset (car table) uc lc)
+  (modify-syntax-entry lc "w   " (standard-syntax-table))
+  (modify-syntax-entry lc "w   " text-mode-syntax-table)
+  (modify-syntax-entry uc "w   " (standard-syntax-table))
+  (modify-syntax-entry uc "w   " text-mode-syntax-table))
+
+(defun set-case-syntax (c syntax table)
+  "Make characters C case-invariant with syntax SYNTAX.
+Sets the entries for character C in standard-case-table,
+standard-syntax-table, and text-mode-syntax-table to indicate this.
+SYNTAX should be \" \", \"w\", \".\" or \"_\"."
+  (aset (car table) c c)
+  (modify-syntax-entry c syntax (standard-syntax-table))
+  (modify-syntax-entry c syntax text-mode-syntax-table))
+
+(provide 'case-table)
diff --git a/lisp/disp-table.el b/lisp/disp-table.el
new file mode 100644
index 0000000000..c0fe4dfe8a
--- /dev/null
+++ b/lisp/disp-table.el
@@ -0,0 +1,115 @@
+;; Functions for dealing with char tables.
+;; Copyright (C) 1987 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+;; Written by Howard Gayle.  See case-table.el for details.
+
+(require 'case-table)
+
+(defun rope-to-vector (rope)
+  (let* ((len (/ (length rope) 2))
+	 (vector (make-vector len nil))
+	 (i 0))
+    (while (< i len)
+      (aset vector i (rope-elt rope i))
+      (setq i (1+ i)))))
+
+(defun describe-display-table (DT)
+  "Describe the display-table DT in a help buffer."
+  (with-output-to-temp-buffer "*Help*"
+    (princ "\nTruncation glyf: ")
+    (prin1 (aref dt 256))
+    (princ "\nWrap glyf: ")
+    (prin1 (aref dt 257))
+    (princ "\nEscape glyf: ")
+    (prin1 (aref dt 258))
+    (princ "\nCtrl glyf: ")
+    (prin1 (aref dt 259))
+    (princ "\nSelective display rope: ")
+    (prin1 (rope-to-vector (aref dt 260)))
+    (princ "\nCharacter display ropes:\n")
+    (let ((vector (make-vector 256 nil))
+	  (i 0))
+      (while (< i 256)
+	(aset vector i
+	      (if (stringp (aref dt i))
+		  (rope-to-vector (aref dt i))
+		(aref dt i)))
+	(setq i (1+ i)))
+      (describe-vector vector))
+    (print-help-return-message)))
+
+(defun describe-current-display-table ()
+   "Describe the display-table in use in the selected window and buffer."
+   (interactive)
+   (describe-display-table
+    (or (window-display-table (selected-window))
+	buffer-display-table
+	standard-display-table)))
+
+(defun make-display-table ()
+  (make-vector 261 nil))
+
+(defun standard-display-8bit (l h)
+  "Display characters in the range [L, H] literally."
+  (while (<= l h)
+    (if (and (>= l ?\ ) (< l 127))
+	(if standard-display-table (aset standard-display-table l nil))
+      (or standard-display-table
+	  (setq standard-display-table (make-vector 261 nil)))
+      (aset standard-display-table l l))
+    (setq l (1+ l))))
+
+(defun standard-display-ascii (c s)
+  "Display character C using string S."
+  (or standard-display-table
+      (setq standard-display-table (make-vector 261 nil)))
+  (aset standard-display-table c (apply 'make-rope (append s nil))))
+
+(defun standard-display-g1 (c sc)
+  "Display character C as character SC in the g1 character set."
+  (or standard-display-table
+      (setq standard-display-table (make-vector 261 nil)))
+  (aset standard-display-table c
+	(make-rope (create-glyf (concat "\016" (char-to-string sc) "\017")))))
+
+(defun standard-display-graphic (c gc)
+  "Display character C as character GC in graphics character set."
+  (or standard-display-table
+      (setq standard-display-table (make-vector 261 nil)))
+  (aset standard-display-table c
+	(make-rope (create-glyf (concat "\e(0" (char-to-string gc) "\e(B")))))
+
+(defun standard-display-underline (c uc)
+  "Display character C as character UC plus underlining."
+  (or standard-display-table
+      (setq standard-display-table (make-vector 261 nil)))
+  (aset standard-display-table c
+	(make-rope (create-glyf (concat "\e[4m" (char-to-string uc) "\e[m")))))
+
+(defun create-glyf (string)
+  (let ((i 256))
+    (while (and (< i 65536) (aref glyf-table i)
+		(not (string= (aref glyf-table i) string)))
+      (setq i (1+ i)))
+    (if (= i 65536)
+	(error "No free glyf codes remain"))
+    (aset glyf-table i string)))
+
+(provide 'disp-table)
diff --git a/lisp/ehelp.el b/lisp/ehelp.el
new file mode 100644
index 0000000000..48c6c5b169
--- /dev/null
+++ b/lisp/ehelp.el
@@ -0,0 +1,338 @@
+;; Copyright (C) 1986 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+(require 'electric)
+(provide 'ehelp) 
+
+(defvar electric-help-map ()
+  "Keymap defining commands available whilst scrolling
+through a buffer in electric-help-mode")
+
+(put 'electric-help-undefined 'suppress-keymap t)
+(if electric-help-map
+    ()
+  (let ((map (make-keymap)))
+    (fillarray map 'electric-help-undefined)
+    (define-key map (char-to-string meta-prefix-char) (copy-keymap map))
+    (define-key map (char-to-string help-char) 'electric-help-help)
+    (define-key map "?" 'electric-help-help)
+    (define-key map " " 'scroll-up)
+    (define-key map "\^?" 'scroll-down)
+    (define-key map "." 'beginning-of-buffer)
+    (define-key map "<" 'beginning-of-buffer)
+    (define-key map ">" 'end-of-buffer)
+    ;(define-key map "\C-g" 'electric-help-exit)
+    (define-key map "q" 'electric-help-exit)
+    (define-key map "Q" 'electric-help-exit)
+    ;;a better key than this?
+    (define-key map "r" 'electric-help-retain)
+
+    (setq electric-help-map map)))
+   
+(defun electric-help-mode ()
+  "with-electric-help temporarily places its buffer in this mode
+\(On exit from with-electric-help, the buffer is put in default-major-mode)"
+  (setq buffer-read-only t)
+  (setq mode-name "Help")
+  (setq major-mode 'help)
+  (setq mode-line-buffer-identification '(" Help:  %b"))
+  (use-local-map electric-help-map)
+  ;; this is done below in with-electric-help
+  ;(run-hooks 'electric-help-mode-hook)
+  )
+
+(defun with-electric-help (thunk &optional buffer noerase)
+  "Arguments are THUNK &optional BUFFER NOERASE.
+BUFFER defaults to \"*Help*\"
+THUNK is a function of no arguments which is called to initialise
+ the contents of BUFFER.  BUFFER will be erased before THUNK is called unless
+ NOERASE is non-nil.  THUNK will be called with  standard-output  bound to
+ the buffer specified by BUFFER
+
+After THUNK has been called, this function \"electrically\" pops up a window
+in which BUFFER is displayed and allows the user to scroll through that buffer
+in electric-help-mode.
+When the user exits (with electric-help-exit, or otherwise) the help
+buffer's window disappears (ie we use save-window-excursion)
+BUFFER is put into default-major-mode (or fundamental-mode) when we exit"
+  (setq buffer (get-buffer-create (or buffer "*Help*")))
+  (let ((one (one-window-p t))
+	(two nil))
+    (save-window-excursion
+      (save-excursion
+	(if one (goto-char (window-start (selected-window))))
+	(let ((pop-up-windows t))
+	  (pop-to-buffer buffer))
+	(unwind-protect
+	    (progn
+	      (save-excursion
+		(set-buffer buffer)
+		(electric-help-mode)
+		(setq buffer-read-only nil)
+		(or noerase (erase-buffer)))
+	      (let ((standard-output buffer))
+		(if (funcall thunk)
+		    ()
+		  (set-buffer buffer)
+		  (set-buffer-modified-p nil)
+		  (goto-char (point-min))
+		  (if one (shrink-window-if-larger-than-buffer (selected-window)))))
+	      (set-buffer buffer)
+	      (run-hooks 'electric-help-mode-hook)
+	      (setq two (electric-help-command-loop))
+	      (cond ((eq (car-safe two) 'retain)
+		     (setq two (vector (window-height (selected-window))
+				       (window-start (selected-window))
+				       (window-hscroll (selected-window))
+				       (point))))
+		    (t (setq two nil))))
+				  
+	  (message "")
+	  (set-buffer buffer)
+	  (setq buffer-read-only nil)
+	  (condition-case ()
+	      (funcall (or default-major-mode 'fundamental-mode))
+	    (error nil)))))
+    (if two
+	(let ((pop-up-windows t)
+	      tem)
+	  (pop-to-buffer buffer)
+	  (setq tem (- (window-height (selected-window)) (elt two 0)))
+	  (if (> tem 0) (shrink-window tem))
+	  (set-window-start (selected-window) (elt two 1) t)
+	  (set-window-hscroll (selected-window) (elt two 2))
+	  (goto-char (elt two 3)))
+      ;;>> Perhaps this shouldn't be done.
+      ;; so that when we say "Press space to bury" we mean it
+      (replace-buffer-in-windows buffer)
+      ;; must do this outside of save-window-excursion
+      (bury-buffer buffer))))
+
+(defun electric-help-command-loop ()
+  (catch 'exit
+    (if (pos-visible-in-window-p (point-max))
+	(progn (message "<<< Press Space to bury the help buffer >>>")
+	       (if (= (setq unread-command-char (read-char)) ?\  )
+		   (progn (setq unread-command-char -1)
+			  (throw 'exit t)))))
+    (let (up down both neither
+	  (standard (and (eq (key-binding " ")
+			     'scroll-up)
+			 (eq (key-binding "\^?")
+			     'scroll-down)
+			 (eq (key-binding "Q")
+			     'electric-help-exit)
+			 (eq (key-binding "q")
+			     'electric-help-exit))))
+      (Electric-command-loop
+        'exit
+	(function (lambda ()
+	  (let ((min (pos-visible-in-window-p (point-min)))
+		(max (pos-visible-in-window-p (point-max))))
+	    (cond ((and min max)
+		   (cond (standard "Press Q to exit ")
+			 (neither)
+			 (t (setq neither (substitute-command-keys "Press \\[scroll-up] to exit ")))))
+		  (min
+		   (cond (standard "Press SPC to scroll, Q to exit ")
+			 (up)
+			 (t (setq up (substitute-command-keys "Press \\[scroll-up] to scroll; \\[electric-help-exit] to exit ")))))
+		  (max
+		   (cond (standard "Press DEL to scroll back, Q to exit ")
+			 (down)
+			 (t (setq down (substitute-command-keys "Press \\[scroll-down] to scroll back, \\[scroll-up] to exit ")))))
+		  (t
+		   (cond (standard "Press SPC to scroll, DEL to scroll back, Q to exit ")
+			 (both)
+			 (t (setq both (substitute-command-keys "Press \\[scroll-up] to scroll, \\[scroll-down] to scroll back, \\[electric-help-exit] to exit ")))))))))
+		    t))))
+
+
+
+;(defun electric-help-scroll-up (arg)
+;  ">>>Doc"
+;  (interactive "P")
+;  (if (and (null arg) (pos-visible-in-window-p (point-max)))
+;      (electric-help-exit)
+;    (scroll-up arg)))
+
+(defun electric-help-exit ()
+  ">>>Doc"
+  (interactive)
+  (throw 'exit t))
+
+(defun electric-help-retain ()
+  "Exit electric-help, retaining the current window/buffer conifiguration.
+\(The *Help* buffer will not be selected, but \\[switch-to-buffer-other-window] RET
+will select it.)"
+  (interactive)
+  (throw 'exit '(retain)))
+
+
+;(defun electric-help-undefined ()
+;  (interactive)
+;  (let* ((keys (this-command-keys))
+;	 (n (length keys)))
+;    (if (or (= n 1)
+;	    (and (= n 2)
+;		 meta-flag
+;		 (eq (aref keys 0) meta-prefix-char)))
+;	(setq unread-command-char last-input-char
+;	      current-prefix-arg prefix-arg)
+;      ;;>>> I don't care.
+;      ;;>>> The emacs command-loop is too much pure pain to
+;      ;;>>> duplicate
+;      ))
+;  (throw 'exit t))
+
+(defun electric-help-undefined ()
+  (interactive)
+  (error "%s is undefined -- Press %s to exit"
+	 (mapconcat 'single-key-description (this-command-keys) " ")
+	 (if (eq (key-binding "Q") 'electric-help-exit)
+	     "Q"
+	   (substitute-command-keys "\\[electric-help-exit]"))))
+
+
+;>>> this needs to be hairified (recursive help, anybody?)
+(defun electric-help-help ()
+  (interactive)
+  (if (and (eq (key-binding "Q") 'electric-help-exit)
+	   (eq (key-binding " ") 'scroll-up)
+	   (eq (key-binding "\^?") 'scroll-down))
+      (message "SPC scrolls forward, DEL scrolls back, Q exits and burys help buffer")
+    ;; to give something for user to look at while slow substitute-cmd-keys
+    ;;  grinds away
+    (message "Help...")
+    (message "%s" (substitute-command-keys "\\[scroll-up] scrolls forward, \\[scroll-down] scrolls back, \\[electric-help-exit] exits.")))
+  (sit-for 2))
+
+
+(defun electric-helpify (fun)
+  (let ((name "*Help*"))
+    (if (save-window-excursion
+	  ;; kludge-o-rama
+	  (let* ((p (symbol-function 'print-help-return-message))
+		 (b (get-buffer name))
+		 (m (buffer-modified-p b)))
+	    (and b (not (get-buffer-window b))
+		 (setq b nil))
+	    (unwind-protect
+		(progn
+		  (message "%s..." (capitalize (symbol-name fun)))
+		  ;; with-output-to-temp-buffer marks the buffer as unmodified.
+		  ;; kludging excessively and relying on that as some sort
+		  ;;  of indication leads to the following abomination...
+		  ;;>> This would be doable without such icky kludges if either
+		  ;;>> (a) there were a function to read the interactive
+		  ;;>>     args for a command and return a list of those args.
+		  ;;>>     (To which one would then just apply the command)
+		  ;;>>     (The only problem with this is that interactive-p
+		  ;;>>      would break, but that is such a misfeature in
+		  ;;>>      any case that I don't care)
+		  ;;>>     It is easy to do this for emacs-lisp functions;
+		  ;;>>     the only problem is getting the interactive spec
+		  ;;>>     for subrs
+		  ;;>> (b) there were a function which returned a
+		  ;;>>     modification-tick for a buffer.  One could tell
+		  ;;>>     whether a buffer had changed by whether the
+		  ;;>>     modification-tick were different.
+		  ;;>>     (Presumably there would have to be a way to either
+		  ;;>>      restore the tick to some previous value, or to
+		  ;;>>      suspend updating of the tick in order to allow
+		  ;;>>      things like momentary-string-display)
+		  (and b
+		       (save-excursion
+			 (set-buffer b)
+			 (set-buffer-modified-p t)))
+		  (fset 'print-help-return-message 'ignore)
+		  (call-interactively fun)
+		  (and (get-buffer name)
+		       (get-buffer-window (get-buffer name))
+		       (or (not b)
+			   (not (eq b (get-buffer name)))
+			   (not (buffer-modified-p b)))))
+	      (fset 'print-help-return-message p)
+	      (and b (buffer-name b)
+		   (save-excursion
+		     (set-buffer b)
+		     (set-buffer-modified-p m))))))
+	(with-electric-help 'ignore name t))))
+
+
+(defun electric-describe-key ()
+  (interactive)
+  (electric-helpify 'describe-key))
+
+(defun electric-describe-mode ()
+  (interactive)
+  (electric-helpify 'describe-mode))
+
+(defun electric-view-lossage ()
+  (interactive)
+  (electric-helpify 'view-lossage))
+
+;(defun electric-help-for-help ()
+;  "See help-for-help"
+;  (interactive)
+;  )
+
+(defun electric-describe-function ()
+  (interactive)
+  (electric-helpify 'describe-function))
+
+(defun electric-describe-variable ()
+  (interactive)
+  (electric-helpify 'describe-variable))
+
+(defun electric-describe-bindings ()
+  (interactive)
+  (electric-helpify 'describe-bindings))
+
+(defun electric-describe-syntax ()
+  (interactive)
+  (electric-helpify 'describe-syntax))
+
+(defun electric-command-apropos ()
+  (interactive)
+  (electric-helpify 'command-apropos))
+
+;(define-key help-map "a" 'electric-command-apropos)
+
+
+
+
+;;;; ehelp-map
+
+(defvar ehelp-map ())
+(if ehelp-map
+    nil
+  (let ((map (copy-keymap help-map))) 
+    (substitute-key-definition 'describe-key 'electric-describe-key map)
+    (substitute-key-definition 'describe-mode 'electric-describe-mode map)
+    (substitute-key-definition 'view-lossage 'electric-view-lossage map)
+    (substitute-key-definition 'describe-function 'electric-describe-function map)
+    (substitute-key-definition 'describe-variable 'electric-describe-variable map)
+    (substitute-key-definition 'describe-bindings 'electric-describe-bindings map)
+    (substitute-key-definition 'describe-syntax 'electric-describe-syntax map)
+
+    (setq ehelp-map map)
+    (fset 'ehelp-command map)))
+
+;; Do (define-key global-map "\C-h" 'ehelp-command) if you want to win
+
diff --git a/lisp/emacs-lisp/helper.el b/lisp/emacs-lisp/helper.el
new file mode 100644
index 0000000000..aa7253eab6
--- /dev/null
+++ b/lisp/emacs-lisp/helper.el
@@ -0,0 +1,147 @@
+;; helper - utility help package for modes which want to provide help
+;; without relinquishing control, e.g. `electric' modes.
+
+;; Copyright (C) 1985 Free Software Foundation, Inc.
+;; Principal author K. Shane Hartman
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+(provide 'helper)			; hey, here's a helping hand.
+
+;; Bind this to a string for <blank> in "... Other keys <blank>".
+;; Helper-help uses this to construct help string when scrolling.
+;; Defaults to "return"
+(defvar Helper-return-blurb nil)
+
+;; Keymap implementation doesn't work too well for non-standard loops.
+;; But define it anyway for those who can use it.  Non-standard loops
+;; will probably have to use Helper-help.  You can't autoload the
+;; keymap either.
+
+
+(defvar Helper-help-map nil)
+(if Helper-help-map
+    nil
+  (setq Helper-help-map (make-keymap))
+  ;(fillarray Helper-help-map 'undefined)
+  (define-key Helper-help-map "m" 'Helper-describe-mode)
+  (define-key Helper-help-map "b" 'Helper-describe-bindings)
+  (define-key Helper-help-map "c" 'Helper-describe-key-briefly)
+  (define-key Helper-help-map "k" 'Helper-describe-key)
+  ;(define-key Helper-help-map "f" 'Helper-describe-function)
+  ;(define-key Helper-help-map "v" 'Helper-describe-variable)
+  (define-key Helper-help-map "?" 'Helper-help-options)
+  (define-key Helper-help-map (char-to-string help-char) 'Helper-help-options)
+  (fset 'Helper-help-map Helper-help-map))
+
+(defun Helper-help-scroller ()
+  (let ((blurb (or (and (boundp 'Helper-return-blurb)
+			Helper-return-blurb)
+		   "return")))
+    (save-window-excursion
+      (goto-char (window-start (selected-window)))
+      (if (get-buffer-window "*Help*")
+	  (pop-to-buffer "*Help*")
+	(switch-to-buffer "*Help*"))
+      (goto-char (point-min))
+      (let ((continue t) state)
+	(while continue
+	  (setq state (+ (* 2 (if (pos-visible-in-window-p (point-max)) 1 0))
+			 (if (pos-visible-in-window-p (point-min)) 1 0)))
+	  (message
+	    (nth state
+		 '("Space forward, Delete back. Other keys %s"
+		   "Space scrolls forward. Other keys %s"
+		   "Delete scrolls back. Other keys %s"
+		   "Type anything to %s"))
+	    blurb)
+	  (setq continue (read-char))
+	  (cond ((and (memq continue '(?\ ?\C-v)) (< state 2))
+		 (scroll-up))
+		((= continue ?\C-l)
+		 (recenter))
+		((and (= continue ?\177) (zerop (% state 2)))
+		 (scroll-down))
+		(t (setq continue nil))))))))
+
+(defun Helper-help-options ()
+  "Describe help options."
+  (interactive)
+  (message "c (key briefly), m (mode), k (key), b (bindings)")
+  ;(message "c (key briefly), m (mode), k (key), v (variable), f (function)")
+  (sit-for 4))
+
+(defun Helper-describe-key-briefly (key)
+  "Briefly describe binding of KEYS."
+  (interactive "kDescribe key briefly: ")
+  (describe-key-briefly key)
+  (sit-for 4))
+
+(defun Helper-describe-key (key)
+  "Describe binding of KEYS."
+  (interactive "kDescribe key: ")
+  (save-window-excursion (describe-key key))
+  (Helper-help-scroller))
+
+(defun Helper-describe-function ()
+  "Describe a function.  Name read interactively."
+  (interactive)
+  (save-window-excursion (call-interactively 'describe-function))
+  (Helper-help-scroller))
+
+(defun Helper-describe-variable ()
+  "Describe a variable.  Name read interactively."
+  (interactive)
+  (save-window-excursion (call-interactively 'describe-variable))
+  (Helper-help-scroller))
+
+(defun Helper-describe-mode ()
+  "Describe the current mode."
+  (interactive)
+  (let ((name mode-name)
+	(documentation (documentation major-mode)))
+    (save-excursion
+      (set-buffer (get-buffer-create "*Help*"))
+      (erase-buffer)
+      (insert name " Mode\n" documentation)))
+  (Helper-help-scroller))
+
+(defun Helper-describe-bindings ()
+  "Describe local key bindings of current mode."
+  (interactive)
+  (message "Making binding list...")
+  (save-window-excursion (describe-bindings))
+  (Helper-help-scroller))
+
+(defun Helper-help ()
+  "Provide help for current mode."
+  (interactive)
+  (let ((continue t) c)
+    (while continue
+      (message "Help (Type ? for further options)")
+      (setq c (char-to-string (downcase (read-char))))
+      (setq c (lookup-key Helper-help-map c))
+      (cond ((eq c 'Helper-help-options)
+	     (Helper-help-options))
+	    ((commandp c)
+	     (call-interactively c)
+	     (setq continue nil))
+	    (t
+	     (ding)
+	     (setq continue nil))))))
+
diff --git a/lisp/emulation/mlconvert.el b/lisp/emulation/mlconvert.el
new file mode 100644
index 0000000000..faf88e5ab3
--- /dev/null
+++ b/lisp/emulation/mlconvert.el
@@ -0,0 +1,272 @@
+;; Convert buffer of Mocklisp code to real lisp.
+;; Copyright (C) 1985 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+(defun convert-mocklisp-buffer ()
+  "Convert buffer of Mocklisp code to real Lisp that GNU Emacs can run."
+  (interactive)
+  (emacs-lisp-mode)
+  (set-syntax-table (copy-sequence (syntax-table)))
+  (modify-syntax-entry ?\| "w")
+  (message "Converting mocklisp (ugh!)...")
+  (goto-char (point-min))
+  (fix-mlisp-syntax)
+
+  ;; Emulation of mocklisp is accurate only within a mocklisp-function
+  ;; so turn any non-function into a defun and then call it.
+  (goto-char (point-min))
+  (condition-case ignore
+      (while t
+	(let ((opt (point))
+	      (form (read (current-buffer))))
+	  (and (listp form)
+	       (not (eq (car form) 'defun))
+	       (progn (insert "))\n\n(ml-foo)\n\n")
+		      (save-excursion
+			(goto-char opt)
+			(skip-chars-forward "\n")
+			(insert "(defun (ml-foo \n "))))))
+    (end-of-file nil))
+
+  (goto-char (point-min))
+  (insert ";;; GNU Emacs code converted from Mocklisp\n")
+  (insert "(require 'mlsupport)\n\n")
+  (fix-mlisp-symbols)
+
+  (goto-char (point-min))
+  (message "Converting mocklisp...done"))
+
+(defun fix-mlisp-syntax ()
+  (while (re-search-forward "['\"]" nil t)
+    (if (= (preceding-char) ?\")
+	(progn (forward-char -1)
+	       (forward-sexp 1))
+      (delete-char -1)
+      (insert "?")
+    (if (or (= (following-char) ?\\) (= (following-char) ?^))
+	  (forward-char 1)
+	(if (looking-at "[^a-zA-Z]")
+	    (insert ?\\)))
+      (forward-char 1)
+      (delete-char 1))))
+
+(defun fix-mlisp-symbols ()
+  (while (progn
+	   (skip-chars-forward " \t\n()")
+	   (not (eobp)))
+    (cond ((or (= (following-char) ?\?)
+	       (= (following-char) ?\"))
+	   (forward-sexp 1))
+	  ((= (following-char) ?\;)
+	   (forward-line 1))
+	  (t
+	   (let ((start (point)) prop)
+	     (forward-sexp 1)
+	     (setq prop (get (intern-soft (buffer-substring start (point)))
+			     'mocklisp))
+	     (cond ((null prop))
+		   ((stringp prop)
+		    (delete-region start (point))
+		    (insert prop))
+		   (t
+		    (save-excursion
+		      (goto-char start)
+		      (funcall prop)))))))))
+
+(defun ml-expansion (ml-name lisp-string)
+  (put ml-name 'mocklisp lisp-string))
+
+(ml-expansion 'defun "ml-defun")
+(ml-expansion 'if "ml-if")
+(ml-expansion 'setq '(lambda ()
+		       (if (looking-at "setq[ \t\n]+buffer-modified-p")
+			   (replace-match "set-buffer-modified-p"))))
+
+(ml-expansion 'while '(lambda ()
+			 (let ((end (progn (forward-sexp 2) (point-marker)))
+			       (start (progn (forward-sexp -1) (point))))
+			   (let ((cond (buffer-substring start end)))
+			     (cond ((equal cond "1")
+				    (delete-region (point) end)
+				    (insert "t"))
+				   (t
+				    (insert "(not (zerop ")
+				    (goto-char end)
+				    (insert "))")))
+			     (set-marker end nil)
+			     (goto-char start)))))
+
+(ml-expansion 'arg "ml-arg")
+(ml-expansion 'nargs "ml-nargs")
+(ml-expansion 'interactive "ml-interactive")
+(ml-expansion 'message "ml-message")
+(ml-expansion 'print "ml-print")
+(ml-expansion 'set "ml-set")
+(ml-expansion 'set-default "ml-set-default")
+(ml-expansion 'provide-prefix-argument "ml-provide-prefix-argument")
+(ml-expansion 'prefix-argument-loop "ml-prefix-argument-loop")
+(ml-expansion 'prefix-argument "ml-prefix-arg")
+(ml-expansion 'use-local-map "ml-use-local-map")
+(ml-expansion 'use-global-map "ml-use-global-map")
+(ml-expansion 'modify-syntax-entry "ml-modify-syntax-entry")
+(ml-expansion 'error-message "error")
+
+(ml-expansion 'dot "point-marker")
+(ml-expansion 'mark "mark-marker")
+(ml-expansion 'beginning-of-file "beginning-of-buffer")
+(ml-expansion 'end-of-file "end-of-buffer")
+(ml-expansion 'exchange-dot-and-mark "exchange-point-and-mark")
+(ml-expansion 'set-mark "set-mark-command")
+(ml-expansion 'argument-prefix "universal-arg")
+
+(ml-expansion 'previous-page "ml-previous-page")
+(ml-expansion 'next-page "ml-next-page")
+(ml-expansion 'next-window "ml-next-window")
+(ml-expansion 'previous-window "ml-previous-window")
+
+(ml-expansion 'newline "ml-newline")
+(ml-expansion 'next-line "ml-next-line")
+(ml-expansion 'previous-line "ml-previous-line")
+(ml-expansion 'self-insert "self-insert-command")
+(ml-expansion 'meta-digit "digit-argument")
+(ml-expansion 'meta-minus "negative-argument")
+
+(ml-expansion 'newline-and-indent "ml-newline-and-indent")
+(ml-expansion 'yank-from-killbuffer "yank")
+(ml-expansion 'yank-buffer "insert-buffer")
+(ml-expansion 'copy-region "copy-region-as-kill")
+(ml-expansion 'delete-white-space "delete-horizontal-space")
+(ml-expansion 'widen-region "widen")
+
+(ml-expansion 'forward-word '(lambda ()
+			       (if (looking-at "forward-word[ \t\n]*)")
+				   (replace-match "forward-word 1)"))))
+(ml-expansion 'backward-word '(lambda ()
+			       (if (looking-at "backward-word[ \t\n]*)")
+				   (replace-match "backward-word 1)"))))
+
+(ml-expansion 'forward-paren "forward-list")
+(ml-expansion 'backward-paren "backward-list")
+(ml-expansion 'search-reverse "ml-search-backward")
+(ml-expansion 're-search-reverse "ml-re-search-backward")
+(ml-expansion 'search-forward "ml-search-forward")
+(ml-expansion 're-search-forward "ml-re-search-forward")
+(ml-expansion 'quote "regexp-quote")
+(ml-expansion 're-query-replace "query-replace-regexp")
+(ml-expansion 're-replace-string "replace-regexp")
+
+; forward-paren-bl, backward-paren-bl
+
+(ml-expansion 'get-tty-character "read-char")
+(ml-expansion 'get-tty-input "read-input")
+(ml-expansion 'get-tty-string "read-string")
+(ml-expansion 'get-tty-buffer "read-buffer")
+(ml-expansion 'get-tty-command "read-command")
+(ml-expansion 'get-tty-variable "read-variable")
+(ml-expansion 'get-tty-no-blanks-input "read-no-blanks-input")
+(ml-expansion 'get-tty-key "read-key")
+
+(ml-expansion 'c= "char-equal")
+(ml-expansion 'goto-character "goto-char")
+(ml-expansion 'substr "ml-substr")
+(ml-expansion 'variable-apropos "apropos")
+(ml-expansion 'execute-mlisp-buffer "eval-current-buffer")
+(ml-expansion 'execute-mlisp-file "load")
+(ml-expansion 'visit-file "find-file")
+(ml-expansion 'read-file "find-file")
+(ml-expansion 'write-modified-files "save-some-buffers")
+(ml-expansion 'backup-before-writing "make-backup-files")
+(ml-expansion 'write-file-exit "save-buffers-kill-emacs")
+(ml-expansion 'write-named-file "write-file")
+(ml-expansion 'change-file-name "set-visited-file-name")
+(ml-expansion 'change-buffer-name "rename-buffer")
+(ml-expansion 'buffer-exists "get-buffer")
+(ml-expansion 'delete-buffer "kill-buffer")
+(ml-expansion 'unlink-file "delete-file")
+(ml-expansion 'unlink-checkpoint-files "delete-auto-save-files")
+(ml-expansion 'file-exists "file-exists-p")
+(ml-expansion 'write-current-file "save-buffer")
+(ml-expansion 'change-directory "cd")
+(ml-expansion 'temp-use-buffer "set-buffer")
+(ml-expansion 'fast-filter-region "filter-region")
+
+(ml-expansion 'pending-input "input-pending-p")
+(ml-expansion 'execute-keyboard-macro "call-last-kbd-macro")
+(ml-expansion 'start-remembering "start-kbd-macro")
+(ml-expansion 'end-remembering "end-kbd-macro")
+(ml-expansion 'define-keyboard-macro "name-last-kbd-macro")
+(ml-expansion 'define-string-macro "ml-define-string-macro")
+
+(ml-expansion 'current-column "ml-current-column")
+(ml-expansion 'current-indent "ml-current-indent")
+(ml-expansion 'insert-character "insert")
+
+(ml-expansion 'users-login-name "user-login-name")
+(ml-expansion 'users-full-name "user-full-name")
+(ml-expansion 'current-time "current-time-string")
+(ml-expansion 'current-numeric-time "current-numeric-time-you-lose")
+(ml-expansion 'current-buffer-name "buffer-name")
+(ml-expansion 'current-file-name "buffer-file-name")
+
+(ml-expansion 'local-binding-of "local-key-binding")
+(ml-expansion 'global-binding-of "global-key-binding")
+
+;defproc (ProcedureType, "procedure-type");
+
+(ml-expansion 'remove-key-binding "global-unset-key")
+(ml-expansion 'remove-binding "global-unset-key")
+(ml-expansion 'remove-local-binding "local-unset-key")
+(ml-expansion 'remove-all-local-bindings "use-local-map nil")
+(ml-expansion 'autoload "ml-autoload")
+
+(ml-expansion 'checkpoint-frequency "auto-save-interval")
+
+(ml-expansion 'mode-string "mode-name")
+(ml-expansion 'right-margin "fill-column")
+(ml-expansion 'tab-size "tab-width")
+(ml-expansion 'default-right-margin "default-fill-column")
+(ml-expansion 'default-tab-size "default-tab-width")
+(ml-expansion 'buffer-is-modified "(buffer-modified-p)")
+
+(ml-expansion 'file-modified-time "you-lose-on-file-modified-time")
+(ml-expansion 'needs-checkpointing "you-lose-on-needs-checkpointing")
+
+(ml-expansion 'lines-on-screen "set-screen-height")
+(ml-expansion 'columns-on-screen "set-screen-width")
+
+(ml-expansion 'dumped-emacs "t")
+
+(ml-expansion 'buffer-size "ml-buffer-size")
+(ml-expansion 'dot-is-visible "pos-visible-in-window-p")
+
+(ml-expansion 'track-eol-on-^N-^P "track-eol")
+(ml-expansion 'ctlchar-with-^ "ctl-arrow")
+(ml-expansion 'help-on-command-completion-error "completion-auto-help")
+(ml-expansion 'dump-stack-trace "backtrace")
+(ml-expansion 'pause-emacs "suspend-emacs")
+(ml-expansion 'compile-it "compile")
+
+(ml-expansion '!= "/=")
+(ml-expansion '& "logand")
+(ml-expansion '| "logior")
+(ml-expansion '^ "logxor")
+(ml-expansion '! "ml-not")
+(ml-expansion '<< "lsh")
+
+;Variable pause-writes-files
+
diff --git a/lisp/float-sup.el b/lisp/float-sup.el
new file mode 100644
index 0000000000..bf95369fd8
--- /dev/null
+++ b/lisp/float-sup.el
@@ -0,0 +1,53 @@
+;; Basic editing commands for Emacs
+;; Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;; Provide a meaningful error message if we are running on
+;; bare (non-float) emacs.
+;; Can't test for 'floatp since that may be defined by float-imitation
+;; packages like float.el in this very directory.
+
+(if (fboundp 'atan)
+    nil
+  (error "Floating point was disabled at compile time"))
+
+;; provide an easy hook to tell if we are running with floats or not.
+(provide 'lisp-float-type)
+
+;; define pi and e via math-lib calls. (much less prone to killer typos.)
+(defconst pi (* 4 (atan 1)) "The value of Pi (3.1415926...)")
+(defconst e (exp 1) "The value of e (2.7182818...)")
+
+;; Careful when editing this file ... typos here will be hard to spot.
+;; (defconst pi       3.14159265358979323846264338327
+;;  "The value of Pi (3.14159265358979323846264338327...)")
+
+(defconst degrees-to-radians (/ pi 180.0)
+  "Degrees to radian conversion constant")
+(defconst radians-to-degrees (/ 180.0 pi)
+  "Radian to degree conversion constant")
+
+;; these expand to a single multiply by a float
+;; when byte compiled
+
+(defmacro degrees-to-radians (x)
+  "Convert ARG from degrees to radians."
+  (list '* (/ pi 180.0) x))
+(defmacro radians-to-degrees (x)
+  "Convert ARG from radians to degrees."
+  (list '* (/ 180.0 pi) x))
diff --git a/lisp/gosmacs.el b/lisp/gosmacs.el
new file mode 100644
index 0000000000..5ea2697eeb
--- /dev/null
+++ b/lisp/gosmacs.el
@@ -0,0 +1,102 @@
+;; Rebindings to imitate Gosmacs.
+;; Copyright (C) 1986 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+(defvar non-gosmacs-binding-alist nil)
+
+(defun set-gosmacs-bindings ()
+  "Rebind some keys globally to make GNU Emacs resemble Gosling Emacs.
+Use \\[set-gnu-bindings] to restore previous global bindings."
+  (interactive)
+  (setq non-gosmacs-binding-alist
+	(rebind-and-record
+	 '(("\C-x\C-e" compile)
+	   ("\C-x\C-f" save-buffers-kill-emacs)
+	   ("\C-x\C-i" insert-file)
+	   ("\C-x\C-m" save-some-buffers)
+	   ("\C-x\C-n" next-error)
+	   ("\C-x\C-o" switch-to-buffer)
+	   ("\C-x\C-r" insert-file)
+	   ("\C-x\C-u" undo)
+	   ("\C-x\C-v" find-file-other-window)
+	   ("\C-x\C-z" shrink-window)
+	   ("\C-x!" shell-command)
+	   ("\C-xd" delete-window)
+	   ("\C-xn" gosmacs-next-window)
+	   ("\C-xp" gosmacs-previous-window)
+	   ("\C-xz" enlarge-window)
+	   ("\C-z" scroll-one-line-up)
+	   ("\e\C-c" save-buffers-kill-emacs)
+	   ("\e!" line-to-top-of-window)
+	   ("\e(" backward-paragraph)
+	   ("\e)" forward-paragraph)
+	   ("\e?" apropos)
+	   ("\eh" delete-previous-word)
+	   ("\ej" indent-sexp)
+	   ("\eq" query-replace)
+	   ("\er" replace-string)
+	   ("\ez" scroll-one-line-down)
+	   ("\C-_" suspend-emacs)))))
+
+(defun rebind-and-record (bindings)
+  "Establish many new global bindings and record the bindings replaced.
+Arg is an alist whose elements are (KEY DEFINITION).
+Value is a similar alist whose elements describe the same KEYs
+but each with the old definition that was replaced,"
+  (let (old)
+    (while bindings
+      (let* ((this (car bindings))
+	     (key (car this))
+	     (newdef (nth 1 this)))
+	(setq old (cons (list key (lookup-key global-map key)) old))
+	(global-set-key key newdef))
+      (setq bindings (cdr bindings)))
+    (nreverse old)))
+
+(defun set-gnu-bindings ()
+  "Restore the global bindings that were changed by \\[set-gosmacs-bindings]."
+  (interactive)
+  (rebind-and-record non-gosmacs-binding-alist))
+
+(defun gosmacs-previous-window ()
+  "Select the window above or to the left of the window now selected.
+From the window at the upper left corner, select the one at the lower right."
+  (interactive)
+  (select-window (previous-window)))
+
+(defun gosmacs-next-window ()
+  "Select the window below or to the right of the window now selected.
+From the window at the lower right corner, select the one at the upper left."
+  (interactive)
+  (select-window (next-window)))
+
+(defun scroll-one-line-up (&optional arg)
+  "Scroll the selected window up (forward in the text) one line (or N lines)."
+  (interactive "p")
+  (scroll-up (or arg 1)))
+
+(defun scroll-one-line-down (&optional arg)
+  "Scroll the selected window down (backward in the text) one line (or N)."
+  (interactive "p")
+  (scroll-down (or arg 1)))
+
+(defun line-to-top-of-window ()
+  "Scroll the selected window up so that the current line is at the top."
+  (interactive)
+  (recenter 0))
diff --git a/lisp/hexl.el b/lisp/hexl.el
new file mode 100644
index 0000000000..3a7498c831
--- /dev/null
+++ b/lisp/hexl.el
@@ -0,0 +1,668 @@
+;; -*-Emacs-Lisp-*-
+;; hexl-mode -- Edit a file in a hex dump format.
+;; Copyright (C) 1989 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;
+;; By: Keith Gabryelski (ag@wheaties.ai.mit.edu)
+;;
+;; This may be useful in your .emacs:
+;;
+;;	(autoload 'hexl-find-file "hexl"
+;;	  "Edit file FILENAME in hexl-mode." t)
+;;	
+;;	(define-key global-map "\C-c\C-h" 'hexl-find-file)
+;;
+;; NOTE: Remember to change HEXL-PROGRAM or HEXL-OPTIONS if needed.
+;;
+;; Currently hexl only supports big endian hex output with 16 bit
+;; grouping.
+;;
+;; -iso in `hexl-options' will allow iso characters to display in the
+;; ASCII region of the screen (if your emacs supports this) instead of
+;; changing them to dots.
+
+;;
+;; vars here
+;;
+
+(defvar hexl-program "hexl"
+  "The program that will hexlify and de-hexlify its stdin.  hexl-program
+will always be concated with hexl-options and "-de" when dehexlfying a
+buffer.")
+
+(defvar hexl-iso ""
+  "If your emacs can handle ISO characters, this should be set to
+\"-iso\" otherwise it should be \"\".")
+
+(defvar hexl-options (format "-hex %s" hexl-iso)
+  "Options to hexl-program that suit your needs.")
+
+(defvar hexlify-command (format "%s %s" hexl-program hexl-options)
+  "The command to use to hexlify a buffer.  It is the concatination of
+`hexl-program' and `hexl-options'.")
+
+(defvar dehexlify-command (format "%s -de %s" hexl-program hexl-options)
+  "The command to use to unhexlify a buffer.  It is the concatination of
+`hexl-program', the option \"-de\", and `hexl-options'.")
+
+(defvar hexl-max-address 0
+  "Maximum offset into hexl buffer.")
+
+(defvar hexl-mode-map nil)
+
+;; routines
+
+(defun hexl-mode (&optional arg)
+  "\\<hexl-mode-map>
+A major mode for editting binary files in hex dump format.
+
+This function automatically converts a buffer into the hexl format
+using the function `hexlify-buffer'.
+
+Each line in the buffer has an `address' (displayed in hexadecimal)
+representing the offset into the file that the characters on this line
+are at and 16 characters from the file (displayed as hexadecimal
+values grouped every 16 bits) and as their ASCII values.
+
+If any of the characters (displayed as ASCII characters) are
+unprintable (control or meta characters) they will be replaced as
+periods.
+
+If hexl-mode is invoked with an argument the buffer is assumed to be
+in hexl-format.
+
+A sample format:
+
+  HEX ADDR: 0001 0203 0405 0607 0809 0a0b 0c0d 0e0f     ASCII-TEXT
+  --------  ---- ---- ---- ---- ---- ---- ---- ----  ----------------
+  00000000: 5468 6973 2069 7320 6865 786c 2d6d 6f64  This is hexl-mod
+  00000010: 652e 2020 4561 6368 206c 696e 6520 7265  e.  Each line re
+  00000020: 7072 6573 656e 7473 2031 3620 6279 7465  presents 16 byte
+  00000030: 7320 6173 2068 6578 6164 6563 696d 616c  s as hexadecimal
+  00000040: 2041 5343 4949 0a61 6e64 2070 7269 6e74   ASCII.and print
+  00000050: 6162 6c65 2041 5343 4949 2063 6861 7261  able ASCII chara
+  00000060: 6374 6572 732e 2020 416e 7920 636f 6e74  cters.  Any cont
+  00000070: 726f 6c20 6f72 206e 6f6e 2d41 5343 4949  rol or non-ASCII
+  00000080: 2063 6861 7261 6374 6572 730a 6172 6520   characters.are 
+  00000090: 6469 7370 6c61 7965 6420 6173 2070 6572  displayed as per
+  000000a0: 696f 6473 2069 6e20 7468 6520 7072 696e  iods in the prin
+  000000b0: 7461 626c 6520 6368 6172 6163 7465 7220  table character 
+  000000c0: 7265 6769 6f6e 2e0a                      region..
+
+Movement is as simple as movement in a normal emacs text buffer.  Most
+cursor movement bindings are the same (ie. Use \\[hexl-backward-char], \\[hexl-forward-char], \\[hexl-next-line], and \\[hexl-previous-line]
+to move the cursor left, right, down, and up).
+
+Advanced cursor movement commands (ala \\[hexl-beginning-of-line], \\[hexl-end-of-line], \\[hexl-beginning-of-buffer], and \\[hexl-end-of-buffer]) are
+also supported.
+
+There are several ways to change text in hexl mode:
+
+ASCII characters (character between space (0x20) and tilde (0x7E)) are
+bound to self-insert so you can simply type the character and it will
+insert itself (actually overstrike) into the buffer.
+
+\\[hexl-quoted-insert] followed by another keystroke allows you to insert the key even if
+it isn't bound to self-insert.  An octal number can be supplied in place
+of another key to insert the octal number's ASCII representation.
+
+\\[hexl-insert-hex-char] will insert a given hexadecimal value (if it is between 0 and 0xFF)
+into the buffer at the current point.
+
+\\[hexl-insert-octal-char] will insert a given octal value (if it is between 0 and 0377)
+into the buffer at the current point.
+
+\\[hexl-insert-decimal-char] will insert a given decimal value (if it is between 0 and 255)
+into the buffer at the current point.
+
+\\[hexl-save-buffer] will save the buffer in is binary format.
+
+\\[hexl-mode-exit] will exit hexl-mode.
+
+Note: \\[write-file] will write the file out in HEXL FORMAT.
+
+You can use \\[hexl-find-file] to visit a file in hexl-mode.
+
+\\[describe-bindings] for advanced commands."
+  (interactive "p")
+  (if (eq major-mode 'hexl-mode)
+      (error "You are already in hexl mode.")
+    (kill-all-local-variables)
+    (make-local-variable 'hexl-mode-old-local-map)
+    (setq hexl-mode-old-local-map (current-local-map))
+    (use-local-map hexl-mode-map)
+
+    (make-local-variable 'hexl-mode-old-mode-name)
+    (setq hexl-mode-old-mode-name mode-name)
+    (setq mode-name "Hexl")
+
+    (make-local-variable 'hexl-mode-old-major-mode)
+    (setq hexl-mode-old-major-mode major-mode)
+    (setq major-mode 'hexl-mode)
+
+    (let ((modified (buffer-modified-p))
+ 	  (read-only buffer-read-only)
+	  (original-point (1- (point))))
+      (if (not (or (eq arg 1) (not arg)))
+;; if no argument then we guess at hexl-max-address
+          (setq hexl-max-address (+ (* (/ (1- (buffer-size)) 68) 16) 15))
+        (setq buffer-read-only nil)
+        (setq hexl-max-address (1- (buffer-size)))
+        (hexlify-buffer)
+        (set-buffer-modified-p modified)
+        (setq buffer-read-only read-only)
+        (hexl-goto-address original-point)))))
+
+(defun hexl-save-buffer ()
+  "Save a hexl format buffer as binary in visited file if modified."
+  (interactive)
+  (set-buffer-modified-p (if (buffer-modified-p)
+			     (save-excursion
+			       (let ((buf (generate-new-buffer " hexl"))
+				     (name (buffer-name))
+				     (file-name (buffer-file-name))
+				     (start (point-min))
+				     (end (point-max))
+				     modified)
+				 (set-buffer buf)
+				 (insert-buffer-substring name start end)
+				 (set-buffer name)
+				 (dehexlify-buffer)
+				 (save-buffer)
+				 (setq modified (buffer-modified-p))
+				 (delete-region (point-min) (point-max))
+				 (insert-buffer-substring buf start end)
+				 (kill-buffer buf)
+				 modified))
+			   (message "(No changes need to be saved)")
+			   nil)))
+
+(defun hexl-find-file (filename)
+  "Edit file FILENAME in hexl-mode.
+
+Switch to a buffer visiting file FILENAME, creating one in none exists."
+  (interactive "fFilename: ")
+  (find-file filename)
+  (if (not (eq major-mode 'hexl-mode))
+      (hexl-mode)))
+
+(defun hexl-mode-exit (&optional arg)
+  "Exit hexl-mode returning to previous mode.
+With arg, don't unhexlify buffer."
+  (interactive "p")
+  (if (or (eq arg 1) (not arg))
+      (let ((modified (buffer-modified-p))
+	    (read-only buffer-read-only)
+	    (original-point (1+ (hexl-current-address))))
+	(setq buffer-read-only nil)
+	(dehexlify-buffer)
+	(set-buffer-modified-p modified)
+	(setq buffer-read-only read-only)
+	(goto-char original-point)))
+  (setq mode-name hexl-mode-old-mode-name)
+  (use-local-map hexl-mode-old-local-map)
+  (setq major-mode hexl-mode-old-major-mode)
+;; Kludge to update mode-line
+  (switch-to-buffer (current-buffer))
+)
+
+(defun hexl-current-address ()
+  "Return current hexl-address."
+  (interactive)
+  (let ((current-column (- (% (point) 68) 11)) 
+	(hexl-address 0))
+    (setq hexl-address (+ (* (/ (point) 68) 16)
+			  (/ (- current-column  (/ current-column 5)) 2)))
+    hexl-address))
+
+(defun hexl-address-to-marker (address)
+  "Return marker for ADDRESS."
+  (interactive "nAddress: ")
+  (+ (* (/ address 16) 68) 11 (/ (* (% address 16) 5) 2)))
+
+(defun hexl-goto-address (address)
+  "Goto hexl-mode (decimal) address ADDRESS.
+
+Signal error if ADDRESS out of range."
+  (interactive "nAddress: ")
+  (if (or (< address 0) (> address hexl-max-address))
+	  (error "Out of hexl region."))
+  (goto-char (hexl-address-to-marker address)))
+
+(defun hexl-goto-hex-address (hex-address)
+  "Goto hexl-mode address (hex string) HEX-ADDRESS.
+
+Signal error if HEX-ADDRESS is out of range."
+  (interactive "sHex Address: ")
+  (hexl-goto-address (hexl-hex-string-to-integer hex-address)))
+
+(defun hexl-hex-string-to-integer (hex-string)
+  "Return decimal integer for HEX-STRING."
+  (interactive "sHex number: ")
+  (let ((hex-num 0))
+    (while (not (equal hex-string ""))
+      (setq hex-num (+ (* hex-num 16)
+		       (hexl-hex-char-to-integer (string-to-char hex-string))))
+      (setq hex-string (substring hex-string 1)))
+    hex-num))
+
+(defun hexl-octal-string-to-integer (octal-string)
+  "Return decimal integer for OCTAL-STRING."
+  (interactive "sOctal number: ")
+  (let ((oct-num 0))
+    (while (not (equal octal-string ""))
+      (setq oct-num (+ (* oct-num 8)
+		       (hexl-oct-char-to-integer
+			(string-to-char octal-string))))
+      (setq octal-string (substring octal-string 1)))
+    oct-num))
+
+;; move point functions
+
+(defun hexl-backward-char (arg)
+  "Move to left ARG bytes (right if ARG negative) in hexl-mode."
+  (interactive "p")
+  (hexl-goto-address (- (hexl-current-address) arg)))
+
+(defun hexl-forward-char (arg)
+  "Move right ARG bytes (left if ARG negative) in hexl-mode."
+  (interactive "p")
+  (hexl-goto-address (+ (hexl-current-address) arg)))
+
+(defun hexl-backward-short (arg)
+  "Move to left ARG shorts (right if ARG negative) in hexl-mode."
+  (interactive "p")
+  (hexl-goto-address (let ((address (hexl-current-address)))
+		       (if (< arg 0)
+			   (progn
+			     (setq arg (- arg))
+			     (while (> arg 0)
+			       (if (not (equal address (logior address 3)))
+				   (if (> address hexl-max-address)
+				       (progn
+					 (message "End of buffer.")
+					 (setq address hexl-max-address))
+				     (setq address (logior address 3)))
+				 (if (> address hexl-max-address)
+				     (progn
+				       (message "End of buffer.")
+				       (setq address hexl-max-address))
+				   (setq address (+ address 4))))
+			       (setq arg (1- arg)))
+			     (if (> address hexl-max-address)
+				 (progn
+				   (message "End of buffer.")
+				   (setq address hexl-max-address))
+			       (setq address (logior address 3))))
+			 (while (> arg 0)
+			   (if (not (equal address (logand address -4)))
+			       (setq address (logand address -4))
+			     (if (not (equal address 0))
+				 (setq address (- address 4))
+			       (message "Beginning of buffer.")))
+			   (setq arg (1- arg))))
+		       address)))
+
+(defun hexl-forward-short (arg)
+  "Move right ARG shorts (left if ARG negative) in hexl-mode."
+  (interactive "p")
+  (hexl-backward-short (- arg)))
+
+(defun hexl-backward-word (arg)
+  "Move to left ARG words (right if ARG negative) in hexl-mode."
+  (interactive "p")
+  (hexl-goto-address (let ((address (hexl-current-address)))
+		       (if (< arg 0)
+			   (progn
+			     (setq arg (- arg))
+			     (while (> arg 0)
+			       (if (not (equal address (logior address 7)))
+				   (if (> address hexl-max-address)
+				       (progn
+					 (message "End of buffer.")
+					 (setq address hexl-max-address))
+				     (setq address (logior address 7)))
+				 (if (> address hexl-max-address)
+				     (progn
+				       (message "End of buffer.")
+				       (setq address hexl-max-address))
+				   (setq address (+ address 8))))
+			       (setq arg (1- arg)))
+			     (if (> address hexl-max-address)
+				 (progn
+				   (message "End of buffer.")
+				   (setq address hexl-max-address))
+			       (setq address (logior address 7))))
+			 (while (> arg 0)
+			   (if (not (equal address (logand address -8)))
+			       (setq address (logand address -8))
+			     (if (not (equal address 0))
+				 (setq address (- address 8))
+			       (message "Beginning of buffer.")))
+			   (setq arg (1- arg))))
+		       address)))
+
+(defun hexl-forward-word (arg)
+  "Move right ARG words (left if ARG negative) in hexl-mode."
+  (interactive "p")
+  (hexl-backward-word (- arg)))
+
+(defun hexl-previous-line (arg)
+  "Move vertically up ARG lines [16 bytes] (down if ARG negative) in
+hexl-mode.
+
+If there is byte at the target address move to the last byte in that
+line."
+  (interactive "p")
+  (hexl-next-line (- arg)))
+
+(defun hexl-next-line (arg)
+  "Move vertically down ARG lines [16 bytes] (up if ARG negative) in
+hexl-mode.
+
+If there is no byte at the target address move to the last byte in that
+line."
+  (interactive "p")
+  (hexl-goto-address (let ((address (+ (hexl-current-address) (* arg 16)) t))
+		       (if (and (< arg 0) (< address 0))
+				(progn (message "Out of hexl region.")
+				       (setq address
+					     (% (hexl-current-address) 16)))
+			 (if (and (> address hexl-max-address)
+				  (< (% hexl-max-address 16) (% address 16)))
+			     (setq address hexl-max-address)
+			   (if (> address hexl-max-address)
+			       (progn (message "Out of hexl region.")
+				      (setq
+				       address
+				       (+ (logand hexl-max-address -16)
+					  (% (hexl-current-address) 16)))))))
+		       address)))
+
+(defun hexl-beginning-of-buffer (arg)
+  "Move to the beginning of the hexl buffer; leave hexl-mark at previous
+posistion.
+
+With arg N, put point N bytes of the way from the true beginning."
+  (interactive "p")
+  (push-mark (point))
+  (hexl-goto-address (+ 0 (1- arg))))
+
+(defun hexl-end-of-buffer (arg)
+  "Goto hexl-max-address minus ARG."
+  (interactive "p")
+  (push-mark (point))
+  (hexl-goto-address (- hexl-max-address (1- arg))))
+
+(defun hexl-beginning-of-line ()
+  "Goto beginning of line in hexl mode."
+  (interactive)
+  (goto-char (+ (* (/ (point) 68) 68) 11)))
+
+(defun hexl-end-of-line ()
+  "Goto end of line in hexl mode."
+  (interactive)
+  (hexl-goto-address (let ((address (logior (hexl-current-address) 15)))
+		       (if (> address hexl-max-address)
+			   (setq address hexl-max-address))
+		       address)))
+
+(defun hexl-scroll-down (arg)
+  "Scroll hexl buffer window upward ARG lines; or near full window if no ARG."
+  (interactive "P")
+  (if (null arg)
+      (setq arg (1- (window-height)))
+    (setq arg (prefix-numeric-value arg)))
+  (hexl-scroll-up (- arg)))
+
+(defun hexl-scroll-up (arg)
+  "Scroll hexl buffer window upward ARG lines; or near full window if no ARG."
+  (interactive "P")
+  (if (null arg)
+      (setq arg (1- (window-height)))
+    (setq arg (prefix-numeric-value arg)))
+  (let ((movement (* arg 16))
+	(address (hexl-current-address)))
+    (if (or (> (+ address movement) hexl-max-address)
+	    (< (+ address movement) 0))
+	(message "Out of hexl region.")
+      (hexl-goto-address (+ address movement))
+      (recenter 0))))
+
+(defun hexl-beginning-of-1k-page ()
+  "Goto to beginning of 1k boundry."
+  (interactive)
+  (hexl-goto-address (logand (hexl-current-address) -1024)))
+
+(defun hexl-end-of-1k-page ()
+  "Goto to end of 1k boundry."
+  (interactive)
+  (hexl-goto-address (let ((address (logior (hexl-current-address) 1023)))
+		       (if (> address hexl-max-address)
+			   (setq address hexl-max-address))
+		       address)))
+
+(defun hexl-beginning-of-512b-page ()
+  "Goto to beginning of 512 byte boundry."
+  (interactive)
+  (hexl-goto-address (logand (hexl-current-address) -512)))
+
+(defun hexl-end-of-512b-page ()
+  "Goto to end of 512 byte boundry."
+  (interactive)
+  (hexl-goto-address (let ((address (logior (hexl-current-address) 511)))
+		       (if (> address hexl-max-address)
+			   (setq address hexl-max-address))
+		       address)))
+
+(defun hexl-quoted-insert (arg)
+  "Read next input character and insert it.
+Useful for inserting control characters.
+You may also type up to 3 octal digits, to insert a character with that code"
+  (interactive "p")
+  (hexl-insert-char (read-quoted-char) arg))
+
+;00000000: 0011 2233 4455 6677 8899 aabb ccdd eeff  0123456789ABCDEF
+
+(defun hexlify-buffer ()
+  "Convert a binary buffer to hexl format"
+  (interactive)
+  (shell-command-on-region (point-min) (point-max) hexlify-command t))
+
+(defun dehexlify-buffer ()
+  "Convert a hexl format buffer to binary."
+  (interactive)
+  (shell-command-on-region (point-min) (point-max) dehexlify-command t))
+
+(defun hexl-char-after-point ()
+  "Return char for ASCII hex digits at point."
+  (setq lh (char-after (point)))
+  (setq rh (char-after (1+ (point))))
+  (hexl-htoi lh rh))
+
+(defun hexl-htoi (lh rh)
+  "Hex (char) LH (char) RH to integer."
+    (+ (* (hexl-hex-char-to-integer lh) 16)
+       (hexl-hex-char-to-integer rh)))
+
+(defun hexl-hex-char-to-integer (character)
+  "Take a char and return its value as if it was a hex digit."
+  (if (and (>= character ?0) (<= character ?9))
+      (- character ?0)
+    (let ((ch (logior character 32)))
+      (if (and (>= ch ?a) (<= ch ?f))
+	  (- ch (- ?a 10))
+	(error (format "Invalid hex digit `%c'." ch))))))
+
+(defun hexl-oct-char-to-integer (character)
+  "Take a char and return its value as if it was a octal digit."
+  (if (and (>= character ?0) (<= character ?7))
+      (- character ?0)
+    (error (format "Invalid octal digit `%c'." character))))
+
+(defun hexl-printable-character (ch)
+  "Return a displayable string for character CH."
+  (format "%c" (if hexl-iso
+		   (if (or (< ch 32) (and (>= ch 127) (< ch 160)))
+		       46
+		     ch)
+		 (if (or (< ch 32) (>= ch 127))
+		     46
+		   ch))))
+
+(defun hexl-self-insert-command (arg)
+  "Insert this character."
+  (interactive "p")
+  (hexl-insert-char last-command-char arg))
+
+(defun hexl-insert-char (ch num)
+  "Insert a character in a hexl buffer."
+  (let ((address (hexl-current-address)))
+    (while (> num 0)
+      (delete-char 2)
+      (insert (format "%02x" ch))
+      (goto-char
+       (+ (* (/ address 16) 68) 52 (% address 16)))
+      (delete-char 1)
+      (insert (hexl-printable-character ch))
+      (if (eq address hexl-max-address)
+	  (hexl-goto-address address)
+	(hexl-goto-address (1+ address)))
+      (setq num (1- num)))))
+
+;; hex conversion
+
+(defun hexl-insert-hex-char (arg)
+  "Insert a ASCII char ARG times at point for a given hexadecimal number."
+  (interactive "p")
+  (let ((num (hexl-hex-string-to-integer (read-string "Hex number: "))))
+    (if (or (> num 255) (< num 0))
+	(error "Hex number out of range.")
+      (hexl-insert-char num arg))))
+
+(defun hexl-insert-decimal-char (arg)
+  "Insert a ASCII char ARG times at point for a given decimal number."
+  (interactive "p")
+  (let ((num (string-to-int (read-string "Decimal Number: "))))
+    (if (or (> num 255) (< num 0))
+	(error "Decimal number out of range.")
+      (hexl-insert-char num arg))))
+
+(defun hexl-insert-octal-char (arg)
+  "Insert a ASCII char ARG times at point for a given octal number."
+  (interactive "p")
+  (let ((num (hexl-octal-string-to-integer (read-string "Octal Number: "))))
+    (if (or (> num 255) (< num 0))
+	(error "Decimal number out of range.")
+      (hexl-insert-char num arg))))
+
+;; startup stuff.
+
+(if hexl-mode-map
+    nil
+    (setq hexl-mode-map (make-sparse-keymap))
+
+    (define-key hexl-mode-map "\C-a" 'hexl-beginning-of-line)
+    (define-key hexl-mode-map "\C-b" 'hexl-backward-char)
+    (define-key hexl-mode-map "\C-d" 'undefined)
+    (define-key hexl-mode-map "\C-e" 'hexl-end-of-line)
+    (define-key hexl-mode-map "\C-f" 'hexl-forward-char)
+
+    (if (not (eq (key-binding "\C-h") 'help-command))
+	(define-key hexl-mode-map "\C-h" 'undefined))
+
+    (define-key hexl-mode-map "\C-i" 'hexl-self-insert-command)
+    (define-key hexl-mode-map "\C-j" 'hexl-self-insert-command)
+    (define-key hexl-mode-map "\C-k" 'undefined)
+    (define-key hexl-mode-map "\C-m" 'hexl-self-insert-command)
+    (define-key hexl-mode-map "\C-n" 'hexl-next-line)
+    (define-key hexl-mode-map "\C-o" 'undefined)
+    (define-key hexl-mode-map "\C-p" 'hexl-previous-line)
+    (define-key hexl-mode-map "\C-q" 'hexl-quoted-insert)
+    (define-key hexl-mode-map "\C-t" 'undefined)
+    (define-key hexl-mode-map "\C-v" 'hexl-scroll-up)
+    (define-key hexl-mode-map "\C-w" 'undefined)
+    (define-key hexl-mode-map "\C-y" 'undefined)
+
+    (let ((ch 32))
+      (while (< ch 127)
+	(define-key hexl-mode-map (format "%c" ch) 'hexl-self-insert-command)
+	(setq ch (1+ ch))))
+
+    (define-key hexl-mode-map "\e\C-a" 'hexl-beginning-of-512b-page)
+    (define-key hexl-mode-map "\e\C-b" 'hexl-backward-short)
+    (define-key hexl-mode-map "\e\C-c" 'undefined)
+    (define-key hexl-mode-map "\e\C-d" 'hexl-insert-decimal-char)
+    (define-key hexl-mode-map "\e\C-e" 'hexl-end-of-512b-page)
+    (define-key hexl-mode-map "\e\C-f" 'hexl-forward-short)
+    (define-key hexl-mode-map "\e\C-g" 'undefined)
+    (define-key hexl-mode-map "\e\C-h" 'undefined)
+    (define-key hexl-mode-map "\e\C-i" 'undefined)
+    (define-key hexl-mode-map "\e\C-j" 'undefined)
+    (define-key hexl-mode-map "\e\C-k" 'undefined)
+    (define-key hexl-mode-map "\e\C-l" 'undefined)
+    (define-key hexl-mode-map "\e\C-m" 'undefined)
+    (define-key hexl-mode-map "\e\C-n" 'undefined)
+    (define-key hexl-mode-map "\e\C-o" 'hexl-insert-octal-char)
+    (define-key hexl-mode-map "\e\C-p" 'undefined)
+    (define-key hexl-mode-map "\e\C-q" 'undefined)
+    (define-key hexl-mode-map "\e\C-r" 'undefined)
+    (define-key hexl-mode-map "\e\C-s" 'undefined)
+    (define-key hexl-mode-map "\e\C-t" 'undefined)
+    (define-key hexl-mode-map "\e\C-u" 'undefined)
+
+    (define-key hexl-mode-map "\e\C-w" 'undefined)
+    (define-key hexl-mode-map "\e\C-x" 'hexl-insert-hex-char)
+    (define-key hexl-mode-map "\e\C-y" 'undefined)
+
+
+    (define-key hexl-mode-map "\ea" 'hexl-beginning-of-1k-page)
+    (define-key hexl-mode-map "\eb" 'hexl-backward-word)
+    (define-key hexl-mode-map "\ec" 'undefined)
+    (define-key hexl-mode-map "\ed" 'undefined)
+    (define-key hexl-mode-map "\ee" 'hexl-end-of-1k-page)
+    (define-key hexl-mode-map "\ef" 'hexl-forward-word)
+    (define-key hexl-mode-map "\eg" 'hexl-goto-hex-address)
+    (define-key hexl-mode-map "\eh" 'undefined)
+    (define-key hexl-mode-map "\ei" 'undefined)
+    (define-key hexl-mode-map "\ej" 'hexl-goto-address)
+    (define-key hexl-mode-map "\ek" 'undefined)
+    (define-key hexl-mode-map "\el" 'undefined)
+    (define-key hexl-mode-map "\em" 'undefined)
+    (define-key hexl-mode-map "\en" 'undefined)
+    (define-key hexl-mode-map "\eo" 'undefined)
+    (define-key hexl-mode-map "\ep" 'undefined)
+    (define-key hexl-mode-map "\eq" 'undefined)
+    (define-key hexl-mode-map "\er" 'undefined)
+    (define-key hexl-mode-map "\es" 'undefined)
+    (define-key hexl-mode-map "\et" 'undefined)
+    (define-key hexl-mode-map "\eu" 'undefined)
+    (define-key hexl-mode-map "\ev" 'hexl-scroll-down)
+    (define-key hexl-mode-map "\ey" 'undefined)
+    (define-key hexl-mode-map "\ez" 'undefined)
+    (define-key hexl-mode-map "\e<" 'hexl-beginning-of-buffer)
+    (define-key hexl-mode-map "\e>" 'hexl-end-of-buffer)
+
+    (define-key hexl-mode-map "\C-c\C-c" 'hexl-mode-exit)
+
+    (define-key hexl-mode-map "\C-x\C-p" 'undefined)
+    (define-key hexl-mode-map "\C-x\C-s" 'hexl-save-buffer)
+    (define-key hexl-mode-map "\C-x\C-t" 'undefined))
+
+;; The End.
diff --git a/lisp/ledit.el b/lisp/ledit.el
new file mode 100644
index 0000000000..1ab35d5bfb
--- /dev/null
+++ b/lisp/ledit.el
@@ -0,0 +1,138 @@
+;; Emacs side of ledit interface
+;; Copyright (C) 1985 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+;;; To do:
+;;; o lisp -> emacs side of things (grind-definition and find-definition)
+
+(defvar ledit-mode-map nil)
+
+(defconst ledit-zap-file (concat "/tmp/" (user-login-name) ".l1")
+  "File name for data sent to Lisp by Ledit.")
+(defconst ledit-read-file (concat "/tmp/" (user-login-name) ".l2")
+  "File name for data sent to Ledit by Lisp.")
+(defconst ledit-compile-file 
+  (concat "/tmp/" (user-login-name) ".l4")
+  "File name for data sent to Lisp compiler by Ledit.")
+(defconst ledit-buffer "*LEDIT*"
+  "Name of buffer in which Ledit accumulates data to send to Lisp.")
+;These are now in loaddefs.el
+;(defconst ledit-save-files t
+;  "*Non-nil means Ledit should save files before transferring to Lisp.")
+;(defconst ledit-go-to-lisp-string "%?lisp"
+;  "*Shell commands to execute to resume Lisp job.")
+;(defconst ledit-go-to-liszt-string "%?liszt"
+;  "*Shell commands to execute to resume Lisp compiler job.")
+
+(defun ledit-save-defun ()
+  "Save the current defun in the ledit buffer"
+  (interactive)
+  (save-excursion
+   (end-of-defun)
+   (let ((end (point)))
+     (beginning-of-defun)
+     (append-to-buffer ledit-buffer (point) end))
+   (message "Current defun saved for Lisp")))
+
+(defun ledit-save-region (beg end)
+  "Save the current region in the ledit buffer"
+  (interactive "r")
+  (append-to-buffer ledit-buffer beg end)
+  (message "Region saved for Lisp"))
+
+(defun ledit-zap-defun-to-lisp ()
+  "Carry the current defun to lisp"
+  (interactive)
+  (ledit-save-defun)
+  (ledit-go-to-lisp))
+
+(defun ledit-zap-defun-to-liszt ()
+  "Carry the current defun to liszt"
+  (interactive)
+  (ledit-save-defun)
+  (ledit-go-to-liszt))
+
+(defun ledit-zap-region-to-lisp (beg end)
+  "Carry the current region to lisp"
+  (interactive "r")
+  (ledit-save-region beg end)
+  (ledit-go-to-lisp))
+
+(defun ledit-go-to-lisp ()
+  "Suspend Emacs and restart a waiting Lisp job."
+  (interactive)
+  (if ledit-save-files
+      (save-some-buffers))
+  (if (get-buffer ledit-buffer)
+      (save-excursion
+       (set-buffer ledit-buffer)
+       (goto-char (point-min))
+       (write-region (point-min) (point-max) ledit-zap-file)
+       (erase-buffer)))
+  (suspend-emacs ledit-go-to-lisp-string)
+  (load ledit-read-file t t))
+
+(defun ledit-go-to-liszt ()
+  "Suspend Emacs and restart a waiting Liszt job."
+  (interactive)
+  (if ledit-save-files
+      (save-some-buffers))
+  (if (get-buffer ledit-buffer)
+      (save-excursion
+       (set-buffer ledit-buffer)
+       (goto-char (point-min))
+       (insert "(declare (macros t))\n")
+       (write-region (point-min) (point-max) ledit-compile-file)
+       (erase-buffer)))
+  (suspend-emacs ledit-go-to-liszt-string)
+  (load ledit-read-file t t))
+
+(defun ledit-setup ()
+  "Set up key bindings for the Lisp / Emacs interface"
+  (if (not ledit-mode-map)
+      (progn (setq ledit-mode-map (make-sparse-keymap))
+	     (lisp-mode-commands ledit-mode-map)))
+  (define-key ledit-mode-map "\e\^d" 'ledit-save-defun)
+  (define-key ledit-mode-map "\e\^r" 'ledit-save-region)
+  (define-key ledit-mode-map "\^xz" 'ledit-go-to-lisp)
+  (define-key ledit-mode-map "\e\^c" 'ledit-go-to-liszt))
+
+(ledit-setup)
+
+(defun ledit-mode ()
+  "Major mode for editing text and stuffing it to a Lisp job.
+Like Lisp mode, plus these special commands:
+  M-C-d	-- record defun at or after point
+	   for later transmission to Lisp job.
+  M-C-r -- record region for later transmission to Lisp job.
+  C-x z -- transfer to Lisp job and transmit saved text.
+  M-C-c -- transfer to Liszt (Lisp compiler) job
+	   and transmit saved text.
+\\{ledit-mode-map}
+To make Lisp mode automatically change to Ledit mode,
+do (setq lisp-mode-hook 'ledit-from-lisp-mode)"
+  (interactive)
+  (lisp-mode)
+  (ledit-from-lisp-mode))
+
+(defun ledit-from-lisp-mode ()
+  (use-local-map ledit-mode-map)
+  (setq mode-name "Ledit")
+  (setq major-mode 'ledit-mode)
+  (run-hooks 'ledit-mode-hook))
diff --git a/lisp/macros.el b/lisp/macros.el
new file mode 100644
index 0000000000..bd2bd9ce44
--- /dev/null
+++ b/lisp/macros.el
@@ -0,0 +1,103 @@
+;; Non-primitive commands for keyboard macros.
+;; Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+(defun name-last-kbd-macro (symbol)
+  "Assign a name to the last keyboard macro defined.
+One arg, a symbol, which is the name to define.
+The symbol's function definition becomes the keyboard macro string.
+Such a \"function\" cannot be called from Lisp, but it is a valid command
+definition for the editor command loop."
+  (interactive "SName for last kbd macro: ")
+  (or last-kbd-macro
+      (error "No keyboard macro defined"))
+  (and (fboundp symbol)
+       (not (stringp (symbol-function symbol)))
+       (error "Function %s is already defined and not a keyboard macro."
+	      symbol))
+  (fset symbol last-kbd-macro))
+
+(defun insert-kbd-macro (macroname &optional keys)
+  "Insert in buffer the definition of kbd macro NAME, as Lisp code.
+Second argument KEYS non-nil means also record the keys it is on.
+ (This is the prefix argument, when calling interactively.)
+
+This Lisp code will, when executed, define the kbd macro with the
+same definition it has now.  If you say to record the keys,
+the Lisp code will also rebind those keys to the macro.
+Only global key bindings are recorded since executing this Lisp code
+always makes global bindings.
+
+To save a kbd macro, visit a file of Lisp code such as your ~/.emacs,
+use this command, and then save the file."
+  (interactive "CInsert kbd macro (name): \nP")
+  (insert "(fset '")
+  (prin1 macroname (current-buffer))
+  (insert "\n   ")
+  (prin1 (symbol-function macroname) (current-buffer))
+  (insert ")\n")
+  (if keys
+      (let ((keys (where-is-internal macroname nil)))
+	(while keys
+	  (insert "(global-set-key ")
+	  (prin1 (car keys) (current-buffer))
+	  (insert " '")
+	  (prin1 macroname (current-buffer))
+	  (insert ")\n")
+	  (setq keys (cdr keys))))))
+
+(defun kbd-macro-query (flag)
+  "Query user during kbd macro execution.
+With prefix argument, enters recursive edit,
+ reading keyboard commands even within a kbd macro.
+ You can give different commands each time the macro executes.
+Without prefix argument, reads a character.  Your options are:
+ Space -- execute the rest of the macro.
+ DEL -- skip the rest of the macro; start next repetition.
+ C-d -- skip rest of the macro and don't repeat it any more.
+ C-r -- enter a recursive edit, then on exit ask again for a character
+ C-l -- redisplay screen and ask again."
+  (interactive "P")
+  (or executing-macro
+      defining-kbd-macro
+      (error "Not defining or executing kbd macro"))
+  (if flag
+      (let (executing-macro defining-kbd-macro)
+	(recursive-edit))
+    (if (not executing-macro)
+	nil
+      (let ((loop t))
+	(while loop
+	  (let ((char (let ((executing-macro nil)
+			    (defining-kbd-macro nil))
+			(message "Proceed with macro? (Space, DEL, C-d, C-r or C-l) ")
+			(read-char))))
+	    (cond ((= char ? )
+		   (setq loop nil))
+		  ((= char ?\177)
+		   (setq loop nil)
+		   (setq executing-macro ""))
+		  ((= char ?\C-d)
+		   (setq loop nil)
+		   (setq executing-macro t))
+		  ((= char ?\C-l)
+		   (recenter nil))
+		  ((= char ?\C-r)
+		   (let (executing-macro defining-kbd-macro)
+		     (recursive-edit))))))))))
diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el
new file mode 100644
index 0000000000..cf9ef90e89
--- /dev/null
+++ b/lisp/mail/emacsbug.el
@@ -0,0 +1,38 @@
+;; Command to report Emacs bugs to appropriate mailing list.
+;; Not fully installed because it can work only on Internet hosts.
+;; Copyright (C) 1985 Free Software Foundation, Inc.
+;; Principal author K. Shane Hartman
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+;; >> This should be an address which is accessible to your machine,
+;; >> otherwise you can't use this file.  It will only work on the
+;; >> internet with this address.
+
+(defvar bug-gnu-emacs "bug-gnu-emacs@prep.ai.mit.edu"
+  "Address of site maintaining mailing list for Gnu emacs bugs.")
+
+(defun report-emacs-bug (topic)
+  "Report a bug in Gnu emacs.
+Prompts for bug subject.  Leaves you in a mail buffer."
+  (interactive "sBug Subject: ")
+  (mail nil bug-gnu-emacs topic)
+  (goto-char (point-max))
+  (insert "\nIn " (emacs-version) "\n\n")
+  (message (substitute-command-keys "Type \\[mail-send] to send bug report.")))
+
diff --git a/lisp/mail/mail-utils.el b/lisp/mail/mail-utils.el
new file mode 100644
index 0000000000..49c563d65b
--- /dev/null
+++ b/lisp/mail/mail-utils.el
@@ -0,0 +1,195 @@
+;; Utility functions used both by rmail and rnews
+;; Copyright (C) 1985 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+(provide 'mail-utils)
+		     
+;; should be in loaddefs
+(defvar mail-use-rfc822 nil
+  "*If non-nil, use a full, hairy RFC822 parser on mail addresses.
+Otherwise, (the default) use a smaller, somewhat faster and
+often-correct parser.")
+
+(defun mail-string-delete (string start end)
+  "Returns a string containing all of STRING except the part
+from START (inclusive) to END (exclusive)."
+  (if (null end) (substring string 0 start)
+    (concat (substring string 0 start)
+	    (substring string end nil))))
+
+(defun mail-strip-quoted-names (address)
+  "Delete comments and quoted strings in an address list ADDRESS.
+Also delete leading/trailing whitespace and replace FOO <BAR> with just BAR.
+Return a modified address list."
+  (if mail-use-rfc822
+      (progn (require 'rfc822)
+	     (mapconcat 'identity (rfc822-addresses address) ", "))
+    (let (pos)
+     (string-match "\\`[ \t\n]*" address)
+     ;; strip surrounding whitespace
+     (setq address (substring address
+			      (match-end 0)
+			      (string-match "[ \t\n]*\\'" address
+					    (match-end 0))))
+
+     ;; Detect nested comments.
+     (if (string-match "[ \t]*(\\([^)\"\\]\\|\\\\.\\|\\\\\n\\)*(" address)
+	 ;; Strip nested comments.
+	 (save-excursion
+	   (set-buffer (get-buffer-create " *temp*"))
+	   (erase-buffer)
+	   (insert address)
+	   (set-syntax-table lisp-mode-syntax-table)
+	   (goto-char 1)
+	   (while (search-forward "(" nil t)
+	     (forward-char -1)
+	     (skip-chars-backward " \t")
+	     (delete-region (point)
+			    (save-excursion (forward-sexp 1) (point))))
+	   (setq address (buffer-string))
+	   (erase-buffer))
+       ;; Strip non-nested comments an easier way.
+       (while (setq pos (string-match 
+			  ;; This doesn't hack rfc822 nested comments
+			  ;;  `(xyzzy (foo) whinge)' properly.  Big deal.
+			  "[ \t]*(\\([^)\"\\]\\|\\\\.\\|\\\\\n\\)*)"
+			  address))
+	 (setq address
+	       (mail-string-delete address
+				   pos (match-end 0)))))
+
+     ;; strip `quoted' names (This is supposed to hack `"Foo Bar" <bar@host>')
+     (setq pos 0)
+     (while (setq pos (string-match
+			"[ \t]*\"\\([^\"\\]\\|\\\\.\\|\\\\\n\\)*\"[ \t\n]*"
+			address pos))
+       ;; If the next thing is "@", we have "foo bar"@host.  Leave it.
+       (if (and (> (length address) (match-end 0))
+		(= (aref address (match-end 0)) ?@))
+	   (setq pos (match-end 0))
+	 (setq address
+	       (mail-string-delete address
+				   pos (match-end 0)))))
+     ;; Retain only part of address in <> delims, if there is such a thing.
+     (while (setq pos (string-match "\\(,\\|\\`\\)[^,]*<\\([^>,]*>\\)"
+				    address))
+       (let ((junk-beg (match-end 1))
+	     (junk-end (match-beginning 2))
+	     (close (match-end 0)))
+	 (setq address (mail-string-delete address (1- close) close))
+	 (setq address (mail-string-delete address junk-beg junk-end))))
+     address)))
+  
+(or (and (boundp 'rmail-default-dont-reply-to-names)
+	 (not (null rmail-default-dont-reply-to-names)))
+    (setq rmail-default-dont-reply-to-names "info-"))
+
+; rmail-dont-reply-to-names is defined in loaddefs
+(defun rmail-dont-reply-to (userids)
+  "Returns string of mail addresses USERIDS sans any recipients
+that start with matches for  rmail-dont-reply-to-names.
+Usenet paths ending in an element that matches are removed also."
+  (if (null rmail-dont-reply-to-names)
+      (setq rmail-dont-reply-to-names
+	    (concat (if rmail-default-dont-reply-to-names
+			(concat rmail-default-dont-reply-to-names "\\|")
+		        "")
+		    (concat (regexp-quote (user-original-login-name))
+			    "\\>"))))
+  (let ((match (concat "\\(^\\|,\\)[ \t\n]*\\([^,\n]*!\\|\\)\\("
+		       rmail-dont-reply-to-names
+		       "\\)"))
+	(case-fold-search t)
+	pos epos)
+    (while (setq pos (string-match match userids))
+      (if (> pos 0) (setq pos (1+ pos)))
+      (setq epos
+	    (if (string-match "[ \t\n,]+" userids (match-end 0))
+		(match-end 0)
+	      (length userids)))
+      (setq userids
+	    (mail-string-delete
+	      userids pos epos)))
+    ;; get rid of any trailing commas
+    (if (setq pos (string-match "[ ,\t\n]*\\'" userids))
+	(setq userids (substring userids 0 pos)))
+    ;; remove leading spaces. they bother me.
+    (if (string-match "\\s *" userids)
+	(substring userids (match-end 0))
+      userids)))
+
+(defun mail-fetch-field (field-name &optional last all)
+  "Return the value of the header field FIELD.
+The buffer is expected to be narrowed to just the headers of the message.
+If 2nd arg LAST is non-nil, use the last such field if there are several.
+If 3rd arg ALL is non-nil, concatenate all such fields, with commas between."
+  (save-excursion
+    (goto-char (point-min))
+    (let ((case-fold-search t)
+	  (name (concat "^" (regexp-quote field-name) "[ \t]*:[ \t]*")))
+      (goto-char (point-min))
+      (if all
+	  (let ((value ""))
+	    (while (re-search-forward name nil t)
+	      (let ((opoint (point)))
+		(while (progn (forward-line 1)
+			      (looking-at "[ \t]")))
+		(setq value (concat value
+				    (if (string= value "") "" ", ")
+				    (buffer-substring opoint (1- (point)))))))
+	    (and (not (string= value "")) value))
+	(if (re-search-forward name nil t)
+	    (progn
+	      (if last (while (re-search-forward name nil t)))
+	      (let ((opoint (point)))
+		(while (progn (forward-line 1)
+			      (looking-at "[ \t]")))
+		(buffer-substring opoint (1- (point))))))))))
+
+;; Parse a list of tokens separated by commas.
+;; It runs from point to the end of the visible part of the buffer.
+;; Whitespace before or after tokens is ignored,
+;; but whitespace within tokens is kept.
+(defun mail-parse-comma-list ()
+  (let (accumulated
+	beg)
+    (skip-chars-forward " ")
+    (while (not (eobp))
+      (setq beg (point))
+      (skip-chars-forward "^,")
+      (skip-chars-backward " ")
+      (setq accumulated
+	    (cons (buffer-substring beg (point))
+		  accumulated))
+      (skip-chars-forward "^,")
+      (skip-chars-forward ", "))
+    accumulated))
+
+(defun mail-comma-list-regexp (labels)
+  (let (pos)
+    (setq pos (or (string-match "[^ \t]" labels) 0))
+    ;; Remove leading and trailing whitespace.
+    (setq labels (substring labels pos (string-match "[ \t]*$" labels pos)))
+    ;; Change each comma to \|, and flush surrounding whitespace.
+    (while (setq pos (string-match "[ \t]*,[ \t]*" labels))
+      (setq labels
+	    (concat (substring labels 0 pos)
+		    "\\|"
+		    (substring labels (match-end 0))))))
+  labels)
diff --git a/lisp/mail/rmailedit.el b/lisp/mail/rmailedit.el
new file mode 100644
index 0000000000..d5c3dfd336
--- /dev/null
+++ b/lisp/mail/rmailedit.el
@@ -0,0 +1,105 @@
+;; "RMAIL edit mode"  Edit the current message.
+;; Copyright (C) 1985 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+(require 'rmail)
+
+(defvar rmail-edit-map nil)
+(if rmail-edit-map
+    nil
+  (setq rmail-edit-map (nconc (make-sparse-keymap) text-mode-map))
+  (define-key rmail-edit-map "\C-c\C-c" 'rmail-cease-edit)
+  (define-key rmail-edit-map "\C-c\C-]" 'rmail-abort-edit))
+
+;; Rmail Edit mode is suitable only for specially formatted data.
+(put 'rmail-edit-mode 'mode-class 'special)
+
+(defun rmail-edit-mode ()
+  "Major mode for editing the contents of an RMAIL message.
+The editing commands are the same as in Text mode, together with two commands
+to return to regular RMAIL:
+  *  rmail-abort-edit cancels the changes
+     you have made and returns to RMAIL
+  *  rmail-cease-edit makes them permanent.
+\\{rmail-edit-map}"
+  (use-local-map rmail-edit-map)
+  (setq major-mode 'rmail-edit-mode)
+  (setq mode-name "RMAIL Edit")
+  (if (boundp 'mode-line-modified)
+      (setq mode-line-modified (default-value 'mode-line-modified))
+    (setq mode-line-format (default-value 'mode-line-format)))
+  (run-hooks 'text-mode-hook 'rmail-edit-mode-hook))
+
+(defun rmail-edit-current-message ()
+  "Edit the contents of this message."
+  (interactive)
+  (rmail-edit-mode)
+  (make-local-variable 'rmail-old-text)
+  (setq rmail-old-text (buffer-substring (point-min) (point-max)))
+  (setq buffer-read-only nil)
+  (set-buffer-modified-p (buffer-modified-p))
+  ;; Make mode line update.
+  (if (and (eq (key-binding "\C-c\C-c") 'rmail-cease-edit)
+	   (eq (key-binding "\C-c\C-]") 'rmail-abort-edit))
+      (message "Editing: Type C-c C-c to return to Rmail, C-c C-] to abort")
+    (message (substitute-command-keys
+	       "Editing: Type \\[rmail-cease-edit] to return to Rmail, \\[rmail-abort-edit] to abort"))))
+
+(defun rmail-cease-edit ()
+  "Finish editing message; switch back to Rmail proper."
+  (interactive)
+  ;; Make sure buffer ends with a newline.
+  (save-excursion
+    (goto-char (point-max))
+    (if (/= (preceding-char) ?\n)
+	(insert "\n"))
+    ;; Adjust the marker that points to the end of this message.
+    (set-marker (aref rmail-message-vector (1+ rmail-current-message))
+		(point)))
+  (let ((old rmail-old-text))
+    ;; Update the mode line.
+    (set-buffer-modified-p (buffer-modified-p))
+    (rmail-mode-1)
+    (if (and (= (length old) (- (point-max) (point-min)))
+	     (string= old (buffer-substring (point-min) (point-max))))
+	()
+      (setq old nil)
+      (rmail-set-attribute "edited" t)
+      (if (boundp 'rmail-summary-vector)
+	  (progn
+	    (aset rmail-summary-vector (1- rmail-current-message) nil)
+	    (save-excursion
+	      (rmail-widen-to-current-msgbeg
+	        (function (lambda ()
+			    (forward-line 2)
+			    (if (looking-at "Summary-line: ")
+				(let ((buffer-read-only nil))
+				  (delete-region (point)
+						 (progn (forward-line 1)
+							(point))))))))
+	      (rmail-show-message))))))
+  (setq buffer-read-only t))
+
+(defun rmail-abort-edit ()
+  "Abort edit of current message; restore original contents."
+  (interactive)
+  (delete-region (point-min) (point-max))
+  (insert rmail-old-text)
+  (rmail-cease-edit))
+
diff --git a/lisp/mail/rmailkwd.el b/lisp/mail/rmailkwd.el
new file mode 100644
index 0000000000..af48e0f7de
--- /dev/null
+++ b/lisp/mail/rmailkwd.el
@@ -0,0 +1,260 @@
+;; "RMAIL" mail reader for Emacs.
+;; Copyright (C) 1985, 1988 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+;; Global to all RMAIL buffers.  It exists primarily for the sake of
+;; completion.  It is better to use strings with the label functions
+;; and let them worry about making the label.
+
+(defvar rmail-label-obarray (make-vector 47 0))
+
+;; Named list of symbols representing valid message attributes in RMAIL.
+
+(defconst rmail-attributes
+  (cons 'rmail-keywords
+	(mapcar '(lambda (s) (intern s rmail-label-obarray))
+		'("deleted" "answered" "filed" "forwarded" "unseen" "edited"))))
+
+(defconst rmail-deleted-label (intern "deleted" rmail-label-obarray))
+
+;; Named list of symbols representing valid message keywords in RMAIL.
+
+(defvar rmail-keywords nil)
+
+(defun rmail-add-label (string)
+  "Add LABEL to labels associated with current RMAIL message.
+Completion is performed over known labels when reading."
+  (interactive (list (rmail-read-label "Add label")))
+  (rmail-set-label string t))
+
+(defun rmail-kill-label (string)
+  "Remove LABEL from labels associated with current RMAIL message.
+Completion is performed over known labels when reading."
+  (interactive (list (rmail-read-label "Remove label")))
+  (rmail-set-label string nil))
+
+(defun rmail-read-label (prompt)
+  (if (not rmail-keywords) (rmail-parse-file-keywords))
+  (let ((result
+	 (completing-read (concat prompt
+				  (if rmail-last-label
+				      (concat " (default "
+					      (symbol-name rmail-last-label)
+					      "): ")
+				    ": "))
+			  rmail-label-obarray
+			  nil
+			  nil)))
+    (if (string= result "")
+	rmail-last-label
+      (setq rmail-last-label (rmail-make-label result t)))))
+
+(defun rmail-set-label (l state &optional n)
+  (rmail-maybe-set-message-counters)
+  (if (not n) (setq n rmail-current-message))
+  (aset rmail-summary-vector (1- n) nil)
+  (let* ((attribute (rmail-attribute-p l))
+	 (keyword (and (not attribute)
+		       (or (rmail-keyword-p l)
+			   (rmail-install-keyword l))))
+	 (label (or attribute keyword)))
+    (if label
+	(let ((omax (- (buffer-size) (point-max)))
+	      (omin (- (buffer-size) (point-min)))
+	      (buffer-read-only nil)
+	      (case-fold-search t))
+	  (unwind-protect
+	      (save-excursion
+		(widen)
+		(goto-char (rmail-msgbeg n))
+		(forward-line 1)
+		(if (not (looking-at "[01],"))
+		    nil
+		  (let ((start (1+ (point)))
+			(bound))
+		    (narrow-to-region (point) (progn (end-of-line) (point)))
+		    (setq bound (point-max))
+		    (search-backward ",," nil t)
+		    (if attribute
+			(setq bound (1+ (point)))
+		      (setq start (1+ (point))))
+		    (goto-char start)
+;		    (while (re-search-forward "[ \t]*,[ \t]*" nil t)
+;		      (replace-match ","))
+;		    (goto-char start)
+		    (if (re-search-forward
+			   (concat ", " (rmail-quote-label-name label) ",")
+			   bound
+			   'move)
+			(if (not state) (replace-match ","))
+		      (if state (insert " " (symbol-name label) ",")))
+		    (if (eq label rmail-deleted-label)
+			(rmail-set-message-deleted-p n state)))))
+	    (narrow-to-region (- (buffer-size) omin) (- (buffer-size) omax))
+	    (if (= n rmail-current-message) (rmail-display-labels)))))))
+
+;; Commented functions aren't used by RMAIL but might be nice for user
+;; packages that do stuff with RMAIL.  Note that rmail-message-labels-p
+;; is in rmailsum now.
+
+;(defun rmail-message-attribute-p (attribute &optional n)
+;  "Returns t if ATTRIBUTE on NTH or current message."
+;  (rmail-message-labels-p (rmail-make-label attribute t) n))
+
+;(defun rmail-message-keyword-p (keyword &optional n)
+;  "Returns t if KEYWORD on NTH or current message."
+;  (rmail-message-labels-p (rmail-make-label keyword t) n t))
+
+;(defun rmail-message-label-p (label &optional n)
+;  "Returns symbol if LABEL (attribute or keyword) on NTH or current message."
+;  (rmail-message-labels-p (rmail-make-label label t) n 'all))
+
+;; Not used by RMAIL but might be nice for user package.
+
+;(defun rmail-parse-message-labels (&optional n)
+;  "Returns labels associated with NTH or current RMAIL message.
+;Results is a list of two lists.  The first is the message attributes
+;and the second is the message keywords.  Labels are represented as symbols."
+;  (let ((omin (- (buffer-size) (point-min)))
+;	(omax (- (buffer-size) (point-max)))
+;	(result))	
+;    (unwind-protect
+;	(save-excursion
+;	  (let ((beg (rmail-msgbeg (or n rmail-current-message))))
+;	    (widen)
+;	    (goto-char beg)
+;	    (forward-line 1)
+;	    (if (looking-at "[01],")
+;		(save-restriction
+;		  (narrow-to-region (point) (save-excursion (end-of-line) (point)))
+;		  (rmail-nuke-whitespace)
+;		  (goto-char (1+ (point-min)))
+;		  (list (mail-parse-comma-list) (mail-parse-comma-list))))))
+;      (narrow-to-region (- (buffer-size) omin)
+;    			 (- (buffer-size) omax))
+;      nil)))
+
+(defun rmail-attribute-p (s)
+  (let ((symbol (rmail-make-label s)))
+    (if (memq symbol (cdr rmail-attributes)) symbol)))
+
+(defun rmail-keyword-p (s)
+  (let ((symbol (rmail-make-label s)))
+    (if (memq symbol (cdr (rmail-keywords))) symbol)))
+
+(defun rmail-make-label (s &optional forcep)
+  (cond ((symbolp s) s)
+	(forcep (intern (downcase s) rmail-label-obarray))
+	(t  (intern-soft (downcase s) rmail-label-obarray))))
+
+(defun rmail-force-make-label (s)
+  (intern (downcase s) rmail-label-obarray))
+
+(defun rmail-quote-label-name (label)
+  (regexp-quote (symbol-name (rmail-make-label label t))))
+
+;; Motion on messages with keywords.
+
+(defun rmail-previous-labeled-message (n label)
+  "Show previous message with LABEL.  Defaults to last labels used.
+With prefix argument N moves backward N messages with these labels."
+  (interactive "p\nsMove to previous msg with labels: ")
+  (rmail-next-labeled-message (- n) label))
+
+(defun rmail-next-labeled-message (n labels)
+  "Show next message with LABEL.  Defaults to last labels used.
+With prefix argument N moves forward N messages with these labels."
+  (interactive "p\nsMove to next msg with labels: ")
+  (if (string= labels "")
+      (setq labels rmail-last-multi-labels))
+  (or labels
+      (error "No labels to find have been specified previously"))
+  (setq rmail-last-multi-labels labels)
+  (rmail-maybe-set-message-counters)
+  (let ((lastwin rmail-current-message)
+	(current rmail-current-message)
+	(regexp (concat ", ?\\("
+			(mail-comma-list-regexp labels)
+			"\\),")))
+    (save-restriction
+      (widen)
+      (while (and (> n 0) (< current rmail-total-messages))
+	(setq current (1+ current))
+	(if (rmail-message-labels-p current regexp)
+	    (setq lastwin current n (1- n))))
+      (while (and (< n 0) (> current 1))
+	(setq current (1- current))
+	(if (rmail-message-labels-p current regexp)
+	    (setq lastwin current n (1+ n)))))
+    (rmail-show-message lastwin)
+    (if (< n 0)
+	(message "No previous message with labels %s" labels))
+    (if (> n 0)
+	(message "No following message with labels %s" labels))))
+
+;;; Manipulate the file's Labels option.
+
+;; Return a list of symbols for all
+;; the keywords (labels) recorded in this file's Labels option.
+(defun rmail-keywords ()
+  (or rmail-keywords (rmail-parse-file-keywords)))
+
+;; Set rmail-keywords to a list of symbols for all
+;; the keywords (labels) recorded in this file's Labels option.
+(defun rmail-parse-file-keywords ()
+  (save-restriction
+    (save-excursion
+      (widen)
+      (goto-char 1)
+      (setq rmail-keywords
+	    (if (search-forward "\nLabels:" (rmail-msgbeg 1) t)
+		(progn
+		  (narrow-to-region (point) (progn (end-of-line) (point)))
+		  (goto-char (point-min))
+		  (cons 'rmail-keywords
+			(mapcar 'rmail-force-make-label
+				(mail-parse-comma-list)))))))))
+
+;; Add WORD to the list in the file's Labels option.
+;; Any keyword used for the first time needs this done.
+(defun rmail-install-keyword (word)
+  (let ((keyword (rmail-make-label word t))
+	(keywords (rmail-keywords)))
+    (if (not (or (rmail-attribute-p keyword)
+		 (rmail-keyword-p keyword)))
+	(let ((omin (- (buffer-size) (point-min)))
+	      (omax (- (buffer-size) (point-max))))
+	  (unwind-protect
+	      (save-excursion
+		(widen)
+		(goto-char 1)
+		(let ((case-fold-search t)
+		      (buffer-read-only nil))
+		  (or (search-forward "\nLabels:" nil t)
+		      (progn
+			(end-of-line)
+			(insert "\nLabels:")))
+		  (delete-region (point) (progn (end-of-line) (point)))
+		  (setcdr keywords (cons keyword (cdr keywords)))
+		  (while (setq keywords (cdr keywords))
+		    (insert (symbol-name (car keywords)) ","))
+		  (delete-char -1)))
+	    (narrow-to-region (- (buffer-size) omin)
+			      (- (buffer-size) omax)))))
+    keyword))
diff --git a/lisp/makesum.el b/lisp/makesum.el
new file mode 100644
index 0000000000..425895919a
--- /dev/null
+++ b/lisp/makesum.el
@@ -0,0 +1,100 @@
+;; Generate key binding summary for Emacs
+;; Copyright (C) 1985 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+(defun make-command-summary ()
+  "Make a summary of current key bindings in the buffer *Summary*.
+Previous contents of that buffer are killed first."
+  (interactive)
+  (message "Making command summary...")
+  ;; This puts a description of bindings in a buffer called *Help*.
+  (save-window-excursion
+   (describe-bindings))
+  (with-output-to-temp-buffer "*Summary*"
+    (save-excursion
+     (let ((cur-mode mode-name))
+       (set-buffer standard-output)
+       (erase-buffer)
+       (insert-buffer-substring "*Help*")
+       (goto-char (point-min))
+       (delete-region (point) (progn (forward-line 1) (point)))
+       (while (search-forward "         " nil t)
+	 (replace-match "  "))
+       (goto-char (point-min))
+       (while (search-forward "-@ " nil t)
+	 (replace-match "-SP"))
+       (goto-char (point-min))
+       (while (search-forward "  .. ~ " nil t)
+	 (replace-match "SP .. ~"))
+       (goto-char (point-min))
+       (while (search-forward "C-?" nil t)
+	 (replace-match "DEL"))
+       (goto-char (point-min))
+       (while (search-forward "C-i" nil t)
+	 (replace-match "TAB"))
+       (goto-char (point-min))
+       (if (re-search-forward "^Local Bindings:" nil t)
+	   (progn
+	    (forward-char -1)
+	    (insert " for " cur-mode " Mode")
+	    (while (search-forward "??\n" nil t)
+	      (delete-region (point)
+			     (progn
+			      (forward-line -1)
+			      (point))))))
+       (goto-char (point-min))
+       (insert "Emacs command summary, " (substring (current-time-string) 0 10)
+	       ".\n")
+       ;; Delete "key    binding" and underlining of dashes.
+       (delete-region (point) (progn (forward-line 2) (point)))
+       (forward-line 1)			;Skip blank line
+       (while (not (eobp))
+	 (let ((beg (point)))
+	   (or (re-search-forward "^$" nil t)
+	       (goto-char (point-max)))
+	   (double-column beg (point))
+	   (forward-line 1)))
+       (goto-char (point-min)))))
+  (message "Making command summary...done"))
+
+(defun double-column (start end)
+  (interactive "r")
+  (let (half cnt
+        line lines nlines
+	(from-end (- (point-max) end)))
+    (setq nlines (count-lines start end))
+    (if (<= nlines 1)
+	nil
+      (setq half (/ (1+ nlines) 2))
+      (goto-char start)
+      (save-excursion
+       (forward-line half)
+       (while (< half nlines)
+	 (setq half (1+ half))
+	 (setq line (buffer-substring (point) (save-excursion (end-of-line) (point))))
+	 (setq lines (cons line lines))
+	 (delete-region (point) (progn (forward-line 1) (point)))))
+      (setq lines (nreverse lines))
+      (while lines
+	(end-of-line)
+	(indent-to 41)
+	(insert (car lines))
+	(forward-line 1)
+	(setq lines (cdr lines))))
+    (goto-char (- (point-max) from-end))))
diff --git a/lisp/novice.el b/lisp/novice.el
new file mode 100644
index 0000000000..a0417f14ef
--- /dev/null
+++ b/lisp/novice.el
@@ -0,0 +1,105 @@
+;; Handling of disabled commands ("novice mode") for Emacs.
+;; Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+;; This function is called (by autoloading)
+;; to handle any disabled command.
+;; The command is found in this-command
+;; and the keys are returned by (this-command-keys).
+
+(defun disabled-command-hook (&rest ignore)
+  (let (char)
+    (save-window-excursion
+     (with-output-to-temp-buffer "*Help*"
+       (if (= (aref (this-command-keys) 0) ?\M-x)
+	   (princ "You have invoked the disabled command ")
+	 (princ "You have typed ")
+	 (princ (key-description (this-command-keys)))
+	 (princ ", invoking disabled command "))
+       (princ this-command)
+       (princ ":\n")
+       ;; Print any special message saying why the command is disabled.
+       (if (stringp (get this-command 'disabled))
+	   (princ (get this-command 'disabled)))
+       (princ (or (condition-case ()
+		      (documentation this-command)
+		    (error nil))
+		  "<< not documented >>"))
+       ;; Keep only the first paragraph of the documentation.
+       (save-excursion
+	 (set-buffer "*Help*")
+	 (goto-char (point-min))
+	 (if (search-forward "\n\n" nil t)
+	     (delete-region (1- (point)) (point-max))
+	   (goto-char (point-max))))
+       (princ "\n\n")
+       (princ "You can now type
+Space to try the command just this once,
+      but leave it disabled,
+Y to try it and enable it (no questions if you use it again),
+N to do nothing (command remains disabled)."))
+     (message "Type y, n or Space: ")
+     (let ((cursor-in-echo-area t))
+       (while (not (memq (setq char (downcase (read-char)))
+			 '(?  ?y ?n)))
+	 (ding)
+	 (message "Please type y, n or Space: "))))
+    (if (= char ?y)
+	(if (y-or-n-p "Enable command for future editing sessions also? ")
+	    (enable-command this-command)
+	  (put this-command 'disabled nil)))
+    (if (/= char ?n)
+	(call-interactively this-command))))
+
+(defun enable-command (command)
+  "Allow COMMAND to be executed without special confirmation from now on.
+The user's .emacs file is altered so that this will apply
+to future sessions."
+  (interactive "CEnable command: ")
+  (put command 'disabled nil)
+  (save-excursion
+   (set-buffer (find-file-noselect (substitute-in-file-name "~/.emacs")))
+   (goto-char (point-min))
+   (if (search-forward (concat "(put '" (symbol-name command) " ") nil t)
+       (delete-region
+	(progn (beginning-of-line) (point))
+	(progn (forward-line 1) (point)))
+     ;; Must have been disabled by default.
+     (goto-char (point-max))
+     (insert "\n(put '" (symbol-name command) " 'disabled nil)\n"))
+   (setq foo (buffer-modified-p))
+   (save-buffer)))
+
+(defun disable-command (command)
+  "Require special confirmation to execute COMMAND from now on.
+The user's .emacs file is altered so that this will apply
+to future sessions."
+  (interactive "CDisable command: ")
+  (put command 'disabled t)
+  (save-excursion
+   (set-buffer (find-file-noselect (substitute-in-file-name "~/.emacs")))
+   (goto-char (point-min))
+   (if (search-forward (concat "(put '" (symbol-name command) " ") nil t)
+       (delete-region
+	(progn (beginning-of-line) (point))
+	(progn (forward-line 1) (point))))
+   (goto-char (point-max))
+   (insert "(put '" (symbol-name command) " 'disabled t)\n")
+   (save-buffer)))
+
diff --git a/lisp/play/dissociate.el b/lisp/play/dissociate.el
new file mode 100644
index 0000000000..b6ac2fa4ea
--- /dev/null
+++ b/lisp/play/dissociate.el
@@ -0,0 +1,87 @@
+;; Scramble text amusingly for Emacs.
+;; Copyright (C) 1985 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+(defun dissociated-press (&optional arg)
+  "Dissociate the text of the current buffer.
+Output goes in buffer named *Dissociation*,
+which is redisplayed each time text is added to it.
+Every so often the user must say whether to continue.
+If ARG is positive, require ARG chars of continuity.
+If ARG is negative, require -ARG words of continuity.
+Default is 2."
+  (interactive "P")
+  (setq arg (if arg (prefix-numeric-value arg) 2))
+  (let* ((inbuf (current-buffer))
+	 (outbuf (get-buffer-create "*Dissociation*"))
+	 (move-function (if (> arg 0) 'forward-char 'forward-word))
+	 (move-amount (if (> arg 0) arg (- arg)))
+	 (search-function (if (> arg 0) 'search-forward 'word-search-forward))
+	 (last-query-point 0))
+    (switch-to-buffer outbuf)
+    (erase-buffer)
+    (while
+      (save-excursion
+	(goto-char last-query-point)
+	(vertical-motion (- (window-height) 4))
+	(or (= (point) (point-max))
+	    (and (progn (goto-char (point-max))
+			(y-or-n-p "Continue dissociation? "))
+		 (progn
+		   (message "")
+		   (recenter 1)
+		   (setq last-query-point (point-max))
+		   t))))
+      (let (start end)
+	(save-excursion
+	 (set-buffer inbuf)
+	 (setq start (point))
+	 (if (eq move-function 'forward-char)
+	     (progn
+	       (setq end (+ start (+ move-amount (random 16))))
+	       (if (> end (point-max))
+		   (setq end (+ 1 move-amount (random 16))))
+	       (goto-char end))
+	   (funcall move-function
+		    (+ move-amount (random 16))))
+	 (setq end (point)))
+	(let ((opoint (point)))
+	  (insert-buffer-substring inbuf start end)
+	  (save-excursion
+	   (goto-char opoint)
+	   (end-of-line)
+	   (and (> (current-column) fill-column)
+		(do-auto-fill)))))
+      (save-excursion
+       (set-buffer inbuf)
+       (if (eobp)
+	   (goto-char (point-min))
+	 (let ((overlap
+		(buffer-substring (prog1 (point)
+					 (funcall move-function
+						  (- move-amount)))
+				  (point))))
+	   (let (ranval)
+	     (while (< (setq ranval (random)) 0))
+	     (goto-char (1+ (% ranval (1- (point-max))))))
+	   (or (funcall search-function overlap nil t)
+	       (let ((opoint (point)))
+		 (goto-char 1)
+		 (funcall search-function overlap opoint t))))))
+      (sit-for 0))))
diff --git a/lisp/play/gomoku.el b/lisp/play/gomoku.el
new file mode 100644
index 0000000000..4c7620f570
--- /dev/null
+++ b/lisp/play/gomoku.el
@@ -0,0 +1,1166 @@
+;; Gomoku game between you and Emacs
+;; Copyright (C) 1988 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; Gomoku game between you and GNU Emacs.  Last modified on 13 Sep 1988
+;;;
+;;; Written by Ph. Schnoebelen (phs@lifia.imag.fr), 1987, 1988
+;;; with precious advices from J.-F. Rit.
+;;; This has been tested with GNU Emacs 18.50.
+
+(provide 'gomoku)
+
+
+;; RULES:
+;;
+;; Gomoku is a game played between two players on a rectangular board.	Each
+;; player, in turn, marks a free square of its choice. The winner is the first
+;; one to mark five contiguous squares in any direction (horizontally,
+;; vertically or diagonally).
+;;
+;; I have been told that, in "The TRUE Gomoku", some restrictions are made
+;; about the squares where one may play, or else there is a known forced win
+;; for the first player. This program has no such restriction, but it does not
+;; know about the forced win, nor do I.	 Furthermore, you probably do not know
+;; it yourself :-).
+
+
+;; HOW TO INSTALL:
+;;
+;; There is nothing specific w.r.t. installation: just put this file in the
+;; lisp directory and add an autoload for command gomoku in site-init.el. If
+;; you don't want to rebuild Emacs, then every single user interested in
+;; Gomoku will have to put the autoload command in its .emacs file.  Another
+;; possibility is to define in your .emacs some command using (require
+;; 'gomoku).
+;;
+;; The most important thing is to BYTE-COMPILE gomoku.el because it is
+;; important that the code be as fast as possible.
+;;
+;; There are two main places where you may want to customize the program: key
+;; bindings and board display. These features are commented in the code. Go
+;; and see.
+
+
+;; HOW TO USE:
+;;
+;; Once this file has been installed, the command "M-x gomoku" will display a
+;; board, the size of which depends on the size of the current window. The
+;; size of the board is easily modified by giving numeric arguments to the
+;; gomoku command and/or by customizing the displaying parameters.
+;;
+;; Emacs plays when it is its turn. When it is your turn, just put the cursor
+;; on the square where you want to play and hit RET, or X, or whatever key you
+;; bind to the command gomoku-human-plays. When it is your turn, Emacs is
+;; idle: you may switch buffers, read your mail, ... Just come back to the
+;; *Gomoku* buffer and resume play.
+
+
+;; ALGORITHM:
+;;
+;; The algorithm is briefly described in section "THE SCORE TABLE". Some
+;; parameters may be modified if you want to change the style exhibited by the
+;; program.
+
+;;;
+;;; GOMOKU MODE AND KEYMAP.
+;;;
+(defvar gomoku-mode-hook nil
+  "If non-nil, its value is called on entry to Gomoku mode.")
+
+(defvar gomoku-mode-map nil
+  "Local keymap to use in Gomoku mode.")
+
+(if gomoku-mode-map nil
+  (setq gomoku-mode-map (make-sparse-keymap))
+
+  ;; Key bindings for cursor motion. Arrow keys are just "function"
+  ;; keys, see below.
+  (define-key gomoku-mode-map "y" 'gomoku-move-nw)		; Y
+  (define-key gomoku-mode-map "u" 'gomoku-move-ne)		; U
+  (define-key gomoku-mode-map "b" 'gomoku-move-sw)		; B
+  (define-key gomoku-mode-map "n" 'gomoku-move-se)		; N
+  (define-key gomoku-mode-map "h" 'gomoku-move-left)		; H
+  (define-key gomoku-mode-map "l" 'gomoku-move-right)		; L
+  (define-key gomoku-mode-map "j" 'gomoku-move-down)		; J
+  (define-key gomoku-mode-map "k" 'gomoku-move-up)		; K
+  (define-key gomoku-mode-map "\C-n" 'gomoku-move-down)		; C-N
+  (define-key gomoku-mode-map "\C-p" 'gomoku-move-up)		; C-P
+  (define-key gomoku-mode-map "\C-f" 'gomoku-move-right)	; C-F
+  (define-key gomoku-mode-map "\C-b" 'gomoku-move-left)		; C-B
+
+  ;; Key bindings for entering Human moves.
+  ;; If you have a mouse, you may also bind some mouse click ...
+  (define-key gomoku-mode-map "X" 'gomoku-human-plays)		; X
+  (define-key gomoku-mode-map "x" 'gomoku-human-plays)		; x
+  (define-key gomoku-mode-map "\C-m" 'gomoku-human-plays)	; RET
+  (define-key gomoku-mode-map "\C-cp" 'gomoku-human-plays)	; C-C P
+  (define-key gomoku-mode-map "\C-cb" 'gomoku-human-takes-back) ; C-C B
+  (define-key gomoku-mode-map "\C-cr" 'gomoku-human-resigns)	; C-C R
+  (define-key gomoku-mode-map "\C-ce" 'gomoku-emacs-plays)	; C-C E
+
+  ;; Key bindings for "function" keys. If your terminal has such
+  ;; keys, make sure they are declared through the function-keymap
+  ;; keymap (see file keypad.el).
+  ;; One problem with keypad.el is that the function-key-sequence
+  ;; function is really slow, so slow that you may want to comment out
+  ;; the following lines ...
+  (if (featurep 'keypad)
+      (let (keys)
+	(if (setq keys (function-key-sequence ?u))		; Up Arrow
+	    (define-key gomoku-mode-map keys 'gomoku-move-up))
+	(if (setq keys (function-key-sequence ?d))		; Down Arrow
+	    (define-key gomoku-mode-map keys 'gomoku-move-down))
+	(if (setq keys (function-key-sequence ?l))		; Left Arrow
+	    (define-key gomoku-mode-map keys 'gomoku-move-left))
+	(if (setq keys (function-key-sequence ?r))		; Right Arrow
+	    (define-key gomoku-mode-map keys 'gomoku-move-right))
+;;	(if (setq keys (function-key-sequence ?e))		; Enter
+;;	    (define-key gomoku-mode-map keys 'gomoku-human-plays))
+;;	(if (setq keys (function-key-sequence ?I))		; Insert
+;;	    (define-key gomoku-mode-map keys 'gomoku-human-plays))
+	)))
+
+
+
+(defun gomoku-mode ()
+  "Major mode for playing Gomoku against Emacs.
+You and Emacs play in turn by marking a free square. You mark it with X
+and Emacs marks it with O. The winner is the first to get five contiguous
+marks horizontally, vertically or in diagonal.
+You play by moving the cursor over the square you choose and hitting RET,
+x, .. or whatever has been set locally.
+
+Other useful commands:
+
+C-c r	Indicate that you resign,
+C-c t	Take back your last move,
+C-c e	Ask for Emacs to play (thus passing).
+
+Commands:
+\\{gomoku-mode-map}
+Entry to this mode calls the value of gomoku-mode-hook
+if that value is non-nil."
+  (interactive)
+  (setq major-mode 'gomoku-mode
+	mode-name "Gomoku")
+  (gomoku-display-statistics)
+  (use-local-map gomoku-mode-map)
+  (run-hooks 'gomoku-mode-hook))
+
+;;;
+;;; THE BOARD.
+;;;
+
+;; The board is a rectangular grid. We code empty squares with 0, X's with 1
+;; and O's with 6. The rectangle is recorded in a one dimensional vector
+;; containing padding squares (coded with -1). These squares allow us to
+;; detect when we are trying to move out of the board.	We denote a square by
+;; its (X,Y) coords, or by the INDEX corresponding to them in the vector.  The
+;; leftmost topmost square has coords (1,1) and index gomoku-board-width + 2.
+;; Similarly, vectors between squares may be given by two DX, DY coords or by
+;; one DEPL (the difference between indexes).
+
+(defvar gomoku-board-width nil
+  "Number of columns on the Gomoku board.")
+
+(defvar gomoku-board-height nil
+  "Number of lines on the Gomoku board.")
+
+(defvar gomoku-board nil
+  "Vector recording the actual state of the Gomoku board.")
+
+(defvar gomoku-vector-length nil
+  "Length of gomoku-board vector.")
+
+(defvar gomoku-draw-limit nil
+  ;; This is usually set to 70% of the number of squares.
+  "After how many moves will Emacs offer a draw ?")
+
+
+(defun gomoku-xy-to-index (x y)
+  "Translate X, Y cartesian coords into the corresponding board index."
+  (+ (* y gomoku-board-width) x y))
+
+(defun gomoku-index-to-x (index)
+  "Return corresponding x-coord of board INDEX."
+  (% index (1+ gomoku-board-width)))
+
+(defun gomoku-index-to-y (index)
+  "Return corresponding y-coord of board INDEX."
+  (/ index (1+ gomoku-board-width)))
+
+(defun gomoku-init-board ()
+  "Create the gomoku-board vector and fill it with initial values."
+  (setq gomoku-board (make-vector gomoku-vector-length 0))
+  ;; Every square is 0 (i.e. empty) except padding squares:
+  (let ((i 0) (ii (1- gomoku-vector-length)))
+    (while (<= i gomoku-board-width)	; The squares in [0..width] and in
+      (aset gomoku-board i  -1)		;    [length - width - 1..length - 1]
+      (aset gomoku-board ii -1)		;    are padding squares.
+      (setq i  (1+ i)
+	    ii (1- ii))))
+  (let ((i 0))
+    (while (< i gomoku-vector-length)
+      (aset gomoku-board i -1)		; and also all k*(width+1)
+      (setq i (+ i gomoku-board-width 1)))))
+
+;;;
+;;; THE SCORE TABLE.
+;;;
+
+;; Every (free) square has a score associated to it, recorded in the
+;; GOMOKU-SCORE-TABLE vector. The program always plays in the square having
+;; the highest score.
+
+(defvar gomoku-score-table nil
+  "Vector recording the actual score of the free squares.")
+
+
+;; The key point point about the algorithm is that, rather than considering
+;; the board as just a set of squares, we prefer to see it as a "space" of
+;; internested 5-tuples of contiguous squares (called qtuples).
+;;
+;; The aim of the program is to fill one qtuple with its O's while preventing
+;; you from filling another one with your X's. To that effect, it computes a
+;; score for every qtuple, with better qtuples having better scores. Of
+;; course, the score of a qtuple (taken in isolation) is just determined by
+;; its contents as a set, i.e. not considering the order of its elements. The
+;; highest score is given to the "OOOO" qtuples because playing in such a
+;; qtuple is winning the game. Just after this comes the "XXXX" qtuple because
+;; not playing in it is just loosing the game, and so on. Note that a
+;; "polluted" qtuple, i.e. one containing at least one X and at least one O,
+;; has score zero because there is no more any point in playing in it, from
+;; both an attacking and a defending point of view.
+;;
+;; Given the score of every qtuple, the score of a given free square on the
+;; board is just the sum of the scores of all the qtuples to which it belongs,
+;; because playing in that square is playing in all its containing qtuples at
+;; once. And it is that function which takes into account the internesting of
+;; the qtuples.
+;;
+;; This algorithm is rather simple but anyway it gives a not so dumb level of
+;; play. It easily extends to "n-dimensional Gomoku", where a win should not
+;; be obtained with as few as 5 contiguous marks: 6 or 7 (depending on n !)
+;; should be preferred.
+
+
+;; Here are the scores of the nine "non-polluted" configurations.  Tuning
+;; these values will change (hopefully improve) the strength of the program
+;; and may change its style (rather aggressive here).
+
+(defconst nil-score	  7  "Score of an empty qtuple.")
+(defconst Xscore	 15  "Score of a qtuple containing one X.")
+(defconst XXscore	400  "Score of a qtuple containing two X's.")
+(defconst XXXscore     1800  "Score of a qtuple containing three X's.")
+(defconst XXXXscore  100000  "Score of a qtuple containing four X's.")
+(defconst Oscore	 35  "Score of a qtuple containing one O.")
+(defconst OOscore	800  "Score of a qtuple containing two O's.")
+(defconst OOOscore    15000  "Score of a qtuple containing three O's.")
+(defconst OOOOscore  800000  "Score of a qtuple containing four O's.")
+
+;; These values are not just random: if, given the following situation:
+;;
+;;			  . . . . . . . O .
+;;			  . X X a . . . X .
+;;			  . . . X . . . X .
+;;			  . . . X . . . X .
+;;			  . . . . . . . b .
+;;
+;; you want Emacs to play in "a" and not in "b", then the parameters must
+;; satisfy the inequality:
+;;
+;;		   6 * XXscore > XXXscore + XXscore
+;;
+;; because "a" mainly belongs to six "XX" qtuples (the others are less
+;; important) while "b" belongs to one "XXX" and one "XX" qtuples.  Other
+;; conditions are required to obtain sensible moves, but the previous example
+;; should illustrate the point. If you manage to improve on these values,
+;; please send me a note. Thanks.
+
+
+;; As we choosed values 0, 1 and 6 to denote empty, X and O squares, the
+;; contents of a qtuple is uniquely determined by the sum of its elements and
+;; we just have to set up a translation table.
+
+(defconst gomoku-score-trans-table
+  (vector nil-score Xscore XXscore XXXscore XXXXscore 0
+	  Oscore    0	   0	   0	    0	      0
+	  OOscore   0	   0	   0	    0	      0
+	  OOOscore  0	   0	   0	    0	      0
+	  OOOOscore 0	   0	   0	    0	      0
+	  0)
+  "Vector associating qtuple contents to their score.")
+
+
+;; If you do not modify drastically the previous constants, the only way for a
+;; square to have a score higher than OOOOscore is to belong to a "OOOO"
+;; qtuple, thus to be a winning move. Similarly, the only way for a square to
+;; have a score between XXXXscore and OOOOscore is to belong to a "XXXX"
+;; qtuple. We may use these considerations to detect when a given move is
+;; winning or loosing.
+
+(defconst gomoku-winning-threshold OOOOscore
+  "Threshold score beyond which an emacs move is winning.")
+
+(defconst gomoku-loosing-threshold XXXXscore
+  "Threshold score beyond which a human move is winning.")
+
+
+(defun gomoku-strongest-square ()
+  "Compute index of free square with highest score, or nil if none."
+  ;; We just have to loop other all squares. However there are two problems:
+  ;; 1/ The SCORE-TABLE only gives correct scores to free squares. To speed
+  ;;	up future searches, we set the score of padding or occupied squares
+  ;;	to -1 whenever we meet them.
+  ;; 2/ We want to choose randomly between equally good moves.
+  (let ((score-max 0)
+	(count	   0)			; Number of equally good moves
+	(square	   (gomoku-xy-to-index 1 1)) ; First square
+	(end	   (gomoku-xy-to-index gomoku-board-width gomoku-board-height))
+	best-square score)
+    (while (<= square end)
+      (cond
+       ;; If score is lower (i.e. most of the time), skip to next:
+       ((< (aref gomoku-score-table square) score-max))
+       ;; If score is better, beware of non free squares:
+       ((> (setq score (aref gomoku-score-table square)) score-max)
+	(if (zerop (aref gomoku-board square)) ; is it free ?
+	    (setq count 1		       ; yes: take it !
+		  best-square square
+		  score-max   score)
+	    (aset gomoku-score-table square -1))) ; no: kill it !
+       ;; If score is equally good, choose randomly. But first check freeness:
+       ((not (zerop (aref gomoku-board square)))
+	(aset gomoku-score-table square -1))
+       ((= count (random-number (setq count (1+ count))))
+	(setq best-square square
+	      score-max	  score)))
+      (setq square (1+ square)))	; try next square
+    best-square))
+
+(defun random-number (n)
+  "Return a random integer between 0 and N-1 inclusive."
+  (setq n (% (random) n))
+  (if (< n 0) (- n) n))
+
+;;;
+;;; INITIALIZING THE SCORE TABLE.
+;;;
+
+;; At initialization the board is empty so that every qtuple amounts for
+;; nil-score. Therefore, the score of any square is nil-score times the number
+;; of qtuples that pass through it. This number is 3 in a corner and 20 if you
+;; are sufficiently far from the sides. As computing the number is time
+;; consuming, we initialize every square with 20*nil-score and then only
+;; consider squares at less than 5 squares from one side. We speed this up by
+;; taking symmetry into account.
+;; Also, as it is likely that successive games will be played on a board with
+;; same size, it is a good idea to save the initial SCORE-TABLE configuration.
+
+(defvar gomoku-saved-score-table nil
+  "Recorded initial value of previous score table.")
+
+(defvar gomoku-saved-board-width nil
+  "Recorded value of previous board width.")
+
+(defvar gomoku-saved-board-height nil
+  "Recorded value of previous board height.")
+
+
+(defun gomoku-init-score-table ()
+  "Create the score table vector and fill it with initial values."
+  (if (and gomoku-saved-score-table	; Has it been stored last time ?
+	   (= gomoku-board-width  gomoku-saved-board-width)
+	   (= gomoku-board-height gomoku-saved-board-height))
+      (setq gomoku-score-table (copy-sequence gomoku-saved-score-table))
+      ;; No, compute it:
+      (setq gomoku-score-table
+	    (make-vector gomoku-vector-length (* 20 nil-score)))
+      (let (i j maxi maxj maxi2 maxj2)
+	(setq maxi  (/ (1+ gomoku-board-width) 2)
+	      maxj  (/ (1+ gomoku-board-height) 2)
+	      maxi2 (min 4 maxi)
+	      maxj2 (min 4 maxj))
+	;; We took symmetry into account and could use it more if the board
+	;; would have been square and not rectangular !
+	;; In our case we deal with all (i,j) in the set [1..maxi2]*[1..maxj] U
+	;; [maxi2+1..maxi]*[1..maxj2]. Maxi2 and maxj2 are used because the
+	;; board may well be less than 8 by 8 !
+	(setq i 1)
+	(while (<= i maxi2)
+	  (setq j 1)
+	  (while (<= j maxj)
+	    (gomoku-init-square-score i j)
+	    (setq j (1+ j)))
+	  (setq i (1+ i)))
+	(while (<= i maxi)
+	  (setq j 1)
+	  (while (<= j maxj2)
+	    (gomoku-init-square-score i j)
+	    (setq j (1+ j)))
+	  (setq i (1+ i))))
+      (setq gomoku-saved-score-table  (copy-sequence gomoku-score-table)
+	    gomoku-saved-board-width  gomoku-board-width
+	    gomoku-saved-board-height gomoku-board-height)))
+
+(defun gomoku-nb-qtuples (i j)
+  "Return the number of qtuples containing square I,J."
+  ;; This fonction is complicated because we have to deal
+  ;; with ugly cases like 3 by 6 boards, but it works.
+  ;; If you have a simpler (and correct) solution, send it to me. Thanks !
+  (let ((left  (min 4 (1- i)))
+	(right (min 4 (- gomoku-board-width i)))
+	(up    (min 4 (1- j)))
+	(down  (min 4 (- gomoku-board-height j))))
+    (+ -12
+       (min (max (+ left right) 3) 8)
+       (min (max (+ up down) 3) 8)
+       (min (max (+ (min left up) (min right down)) 3) 8)
+       (min (max (+ (min right up) (min left down)) 3) 8))))
+
+(defun gomoku-init-square-score (i j)
+  "Give initial score to square I,J and to its mirror images."
+  (let ((ii (1+ (- gomoku-board-width i)))
+	(jj (1+ (- gomoku-board-height j)))
+	(sc (* (gomoku-nb-qtuples i j) (aref gomoku-score-trans-table 0))))
+    (aset gomoku-score-table (gomoku-xy-to-index i  j)	sc)
+    (aset gomoku-score-table (gomoku-xy-to-index ii j)	sc)
+    (aset gomoku-score-table (gomoku-xy-to-index i  jj) sc)
+    (aset gomoku-score-table (gomoku-xy-to-index ii jj) sc)))
+
+;;;
+;;; MAINTAINING THE SCORE TABLE.
+;;;
+
+;; We do not provide functions for computing the SCORE-TABLE given the
+;; contents of the BOARD. This would involve heavy nested loops, with time
+;; proportional to the size of the board. It is better to update the
+;; SCORE-TABLE after each move. Updating needs not modify more than 36
+;; squares: it is done in constant time.
+
+(defun gomoku-update-score-table (square dval)
+  "Update score table after SQUARE received a DVAL increment."
+  ;; The board has already been updated when this function is called.
+  ;; Updating scores is done by looking for qtuples boundaries in all four
+  ;; directions and then calling update-score-in-direction.
+  ;; Finally all squares received the right increment, and then are up to
+  ;; date, except possibly for SQUARE itself if we are taking a move back for
+  ;; its score had been set to -1 at the time.
+  (let* ((x    (gomoku-index-to-x square))
+	 (y    (gomoku-index-to-y square))
+	 (imin (max -4 (- 1 x)))
+	 (jmin (max -4 (- 1 y)))
+	 (imax (min 0 (- gomoku-board-width x 4)))
+	 (jmax (min 0 (- gomoku-board-height y 4))))
+    (gomoku-update-score-in-direction imin imax
+				      square 1 0 dval)
+    (gomoku-update-score-in-direction jmin jmax
+				      square 0 1 dval)
+    (gomoku-update-score-in-direction (max imin jmin) (min imax jmax)
+				      square 1 1 dval)
+    (gomoku-update-score-in-direction (max (- 1 y) -4
+					   (- x gomoku-board-width))
+				      (min 0 (- x 5)
+					   (- gomoku-board-height y 4))
+				      square -1 1 dval)))
+
+(defun gomoku-update-score-in-direction (left right square dx dy dval)
+  "Update scores for all squares in the qtuples starting between the LEFTth
+square and the RIGHTth after SQUARE, along the DX, DY direction, considering
+that DVAL has been added on SQUARE."
+  ;; We always have LEFT <= 0, RIGHT <= 0 and DEPL > 0 but we may very well
+  ;; have LEFT > RIGHT, indicating that no qtuple contains SQUARE along that
+  ;; DX,DY direction.
+  (cond
+   ((> left right))			; Quit
+   (t					; Else ..
+    (let (depl square0 square1 square2 count delta)
+      (setq depl    (gomoku-xy-to-index dx dy)
+	    square0 (+ square (* left depl))
+	    square1 (+ square (* right depl))
+	    square2 (+ square0 (* 4 depl)))
+      ;; Compute the contents of the first qtuple:
+      (setq square square0
+	    count  0)
+      (while (<= square square2)
+	(setq count  (+ count (aref gomoku-board square))
+	      square (+ square depl)))
+      (while (<= square0 square1)
+	;; Update the squares of the qtuple beginning in SQUARE0 and ending
+	;; in SQUARE2.
+	(setq delta (- (aref gomoku-score-trans-table count)
+		       (aref gomoku-score-trans-table (- count dval))))
+	(cond ((not (zerop delta))	; or else nothing to update
+	       (setq square square0)
+	       (while (<= square square2)
+		 (if (zerop (aref gomoku-board square)) ; only for free squares
+		     (aset gomoku-score-table square
+			   (+ (aref gomoku-score-table square) delta)))
+		 (setq square (+ square depl)))))
+	;; Then shift the qtuple one square along DEPL, this only requires
+	;; modifying SQUARE0 and SQUARE2.
+	(setq square2 (+ square2 depl)
+	      count   (+ count (- (aref gomoku-board square0))
+			 (aref gomoku-board square2))
+	      square0 (+ square0 depl)))))))
+
+;;;
+;;; GAME CONTROL.
+;;;
+
+;; Several variables are used to monitor a game, including a GAME-HISTORY (the
+;; list of all (SQUARE . PREVSCORE) played) that allows to take moves back
+;; (anti-updating the score table) and to compute the table from scratch in
+;; case of an interruption.
+
+(defvar gomoku-game-in-progress nil
+  "Non-nil if a game is in progress.")
+
+(defvar gomoku-game-history nil
+  "A record of all moves that have been played during current game.")
+
+(defvar gomoku-number-of-moves nil
+  "Number of moves already played in current game.")
+
+(defvar gomoku-number-of-human-moves nil
+  "Number of moves already played by human in current game.")
+
+(defvar gomoku-emacs-played-first nil
+  "Non-nil if Emacs played first.")
+
+(defvar gomoku-human-took-back nil
+  "Non-nil if Human took back a move during the game.")
+
+(defvar gomoku-human-refused-draw nil
+  "Non-nil if Human refused Emacs offer of a draw.")
+
+(defvar gomoku-emacs-is-computing nil
+  ;; This is used to detect interruptions. Hopefully, it should not be needed.
+  "Non-nil if Emacs is in the middle of a computation.")
+
+
+(defun gomoku-start-game (n m)
+  "Initialize a new game on an N by M board."
+  (setq gomoku-emacs-is-computing t)	; Raise flag
+  (setq gomoku-game-in-progress t)
+  (setq gomoku-board-width   n
+	gomoku-board-height  m
+	gomoku-vector-length (1+ (* (+ m 2) (1+ n)))
+	gomoku-draw-limit    (/ (* 7 n m) 10))
+  (setq gomoku-game-history	     nil
+	gomoku-number-of-moves	     0
+	gomoku-number-of-human-moves 0
+	gomoku-emacs-played-first    nil
+	gomoku-human-took-back	     nil
+	gomoku-human-refused-draw    nil)
+  (gomoku-init-display n m)		; Display first: the rest takes time
+  (gomoku-init-score-table)		; INIT-BOARD requires that the score
+  (gomoku-init-board)			;   table be already created.
+  (setq gomoku-emacs-is-computing nil))
+
+(defun gomoku-play-move (square val &optional dont-update-score)
+  "Go to SQUARE, play VAL and update everything."
+  (setq gomoku-emacs-is-computing t)	; Raise flag
+  (cond ((= 1 val)			; a Human move
+	 (setq gomoku-number-of-human-moves (1+ gomoku-number-of-human-moves)))
+	((zerop gomoku-number-of-moves)	; an Emacs move. Is it first ?
+	 (setq gomoku-emacs-played-first t)))
+  (setq gomoku-game-history
+	(cons (cons square (aref gomoku-score-table square))
+	      gomoku-game-history)
+	gomoku-number-of-moves (1+ gomoku-number-of-moves))
+  (gomoku-plot-square square val)
+  (aset gomoku-board square val)	; *BEFORE* UPDATE-SCORE !
+  (if dont-update-score nil
+      (gomoku-update-score-table square val) ; previous val was 0: dval = val
+      (aset gomoku-score-table square -1))
+  (setq gomoku-emacs-is-computing nil))
+
+(defun gomoku-take-back ()
+  "Take back last move and update everything."
+  (setq gomoku-emacs-is-computing t)
+  (let* ((last-move (car gomoku-game-history))
+	 (square (car last-move))
+	 (oldval (aref gomoku-board square)))
+    (if (= 1 oldval)
+	(setq gomoku-number-of-human-moves (1- gomoku-number-of-human-moves)))
+    (setq gomoku-game-history	 (cdr gomoku-game-history)
+	  gomoku-number-of-moves (1- gomoku-number-of-moves))
+    (gomoku-plot-square square 0)
+    (aset gomoku-board square 0)	; *BEFORE* UPDATE-SCORE !
+    (gomoku-update-score-table square (- oldval))
+    (aset gomoku-score-table square (cdr last-move)))
+  (setq gomoku-emacs-is-computing nil))
+
+;;;
+;;; SESSION CONTROL.
+;;;
+
+(defvar gomoku-number-of-wins 0
+  "Number of games already won in this session.")
+
+(defvar gomoku-number-of-losses 0
+  "Number of games already lost in this session.")
+
+(defvar gomoku-number-of-draws 0
+  "Number of games already drawn in this session.")
+
+
+(defun gomoku-terminate-game (result)
+  "Terminate the current game with RESULT."
+  (let (message)
+    (cond
+     ((eq result 'emacs-won)
+      (setq gomoku-number-of-wins (1+ gomoku-number-of-wins))
+      (setq message
+	    (cond ((< gomoku-number-of-moves 20)
+		   "This was a REALLY QUICK win.")
+		  (gomoku-human-refused-draw
+		   "I won... Too bad you refused my offer of a draw !")
+		  (gomoku-human-took-back
+		   "I won... Taking moves back will not help you !")
+		  ((not gomoku-emacs-played-first)
+		   "I won... Playing first did not help you much !")
+		  ((and (zerop gomoku-number-of-losses)
+			(zerop gomoku-number-of-draws)
+			(> gomoku-number-of-wins 1))
+		   "I'm becoming tired of winning...")
+		  (t
+		   "I won."))))
+     ((eq result 'human-won)
+      (setq gomoku-number-of-losses (1+ gomoku-number-of-losses))
+      (setq message
+	    (cond
+	     (gomoku-human-took-back
+	      "OK, you won this one. I, for one, never take my moves back...")
+	     (gomoku-emacs-played-first
+	      "OK, you won this one... so what ?")
+	     (t
+	      "OK, you won this one. Now, let me play first just once."))))
+     ((eq result 'human-resigned)
+      (setq gomoku-number-of-wins (1+ gomoku-number-of-wins))
+      (setq message "So you resign... That's just one more win for me."))
+     ((eq result 'nobody-won)
+      (setq gomoku-number-of-draws (1+ gomoku-number-of-draws))
+      (setq message
+	    (cond
+	     (gomoku-human-took-back
+	      "This is a draw. I, for one, never take my moves back...")
+	     (gomoku-emacs-played-first
+	      "This is a draw... Just chance, I guess.")
+	     (t
+	      "This is a draw. Now, let me play first just once."))))
+     ((eq result 'draw-agreed)
+      (setq gomoku-number-of-draws (1+ gomoku-number-of-draws))
+      (setq message
+	    (cond
+	     (gomoku-human-took-back
+	      "Draw agreed. I, for one, never take my moves back...")
+	     (gomoku-emacs-played-first
+	      "Draw agreed. You were lucky.")
+	     (t
+	      "Draw agreed. Now, let me play first just once."))))
+     ((eq result 'crash-game)
+      (setq message
+	    "Sorry, I have been interrupted and cannot resume that game...")))
+
+    (gomoku-display-statistics)
+    (if message (message message))
+    (ding)
+    (setq gomoku-game-in-progress nil)))
+
+(defun gomoku-crash-game ()
+  "What to do when Emacs detects it has been interrupted."
+  (setq gomoku-emacs-is-computing nil)
+  (gomoku-terminate-game 'crash-game)
+  (sit-for 4)				; Let's see the message
+  (gomoku-prompt-for-other-game))
+
+;;;
+;;; INTERACTIVE COMMANDS.
+;;;
+
+(defun gomoku (&optional n m)
+  "Start a Gomoku game between you and Emacs.
+If a game is in progress, this command allow you to resume it.
+If optional arguments N and M are given, an N by M board is used.
+
+You and Emacs play in turn by marking a free square. You mark it with X
+and Emacs marks it with O. The winner is the first to get five contiguous
+marks horizontally, vertically or in diagonal.
+You play by moving the cursor over the square you choose and hitting RET,
+x, .. or whatever has been set locally.
+Use C-h m for more info."
+  (interactive)
+  (gomoku-switch-to-window)
+  (cond
+   (gomoku-emacs-is-computing
+    (gomoku-crash-game))
+   ((not gomoku-game-in-progress)
+    (let ((max-width (gomoku-max-width))
+	  (max-height (gomoku-max-height)))
+      (or n (setq n max-width))
+      (or m (setq m max-height))
+      (cond ((< n 1)
+	     (error "I need at least 1 column"))
+	    ((< m 1)
+	     (error "I need at least 1 row"))
+	    ((> n max-width)
+	     (error "I cannot display %d columns in that window" n)))
+      (if (and (> m max-height)
+	       (not (equal m gomoku-saved-board-height))
+	       ;; Use EQUAL because SAVED-BOARD-HEIGHT may be nil
+	       (not (y-or-n-p (format "Do you really want %d rows " m))))
+	  (setq m max-height)))
+    (message "One moment, please...")
+    (gomoku-start-game n m)
+    (if (y-or-n-p "Do you allow me to play first ")
+	(gomoku-emacs-plays)
+	(gomoku-prompt-for-move)))
+   ((y-or-n-p "Shall we continue our game ")
+    (gomoku-prompt-for-move))
+   (t
+    (gomoku-human-resigns))))
+
+(defun gomoku-emacs-plays ()
+  "Compute Emacs next move and play it."
+  (interactive)
+  (gomoku-switch-to-window)
+  (cond
+   (gomoku-emacs-is-computing
+    (gomoku-crash-game))
+   ((not gomoku-game-in-progress)
+    (gomoku-prompt-for-other-game))
+   (t
+    (message "Let me think...")
+    (let (square score)
+      (setq square (gomoku-strongest-square))
+      (cond ((null square)
+	     (gomoku-terminate-game 'nobody-won))
+	    (t
+	     (setq score (aref gomoku-score-table square))
+	     (gomoku-play-move square 6)
+	     (cond ((>= score gomoku-winning-threshold)
+		    (gomoku-find-filled-qtuple square 6)
+		    (gomoku-cross-winning-qtuple)
+		    (gomoku-terminate-game 'emacs-won))
+		   ((zerop score)
+		    (gomoku-terminate-game 'nobody-won))
+		   ((and (> gomoku-number-of-moves gomoku-draw-limit)
+			 (not gomoku-human-refused-draw)
+			 (gomoku-offer-a-draw))
+		    (gomoku-terminate-game 'draw-agreed))
+		   (t
+		    (gomoku-prompt-for-move)))))))))
+
+(defun gomoku-human-plays ()
+  "Signal to the Gomoku program that you have played.
+You must have put the cursor on the square where you want to play.
+If the game is finished, this command requests for another game."
+  (interactive)
+  (gomoku-switch-to-window)
+  (cond
+   (gomoku-emacs-is-computing
+    (gomoku-crash-game))
+   ((not gomoku-game-in-progress)
+    (gomoku-prompt-for-other-game))
+   (t
+    (let (square score)
+      (setq square (gomoku-point-square))
+      (cond ((null square)
+	     (error "Your point is not on a square. Retry !"))
+	    ((not (zerop (aref gomoku-board square)))
+	     (error "Your point is not on a free square. Retry !"))
+	    (t
+	     (setq score (aref gomoku-score-table square))
+	     (gomoku-play-move square 1)
+	     (cond ((and (>= score gomoku-loosing-threshold)
+			 ;; Just testing SCORE > THRESHOLD is not enough for
+			 ;; detecting wins, it just gives an indication that
+			 ;; we confirm with GOMOKU-FIND-FILLED-QTUPLE.
+			 (gomoku-find-filled-qtuple square 1))
+		    (gomoku-cross-winning-qtuple)
+		    (gomoku-terminate-game 'human-won))
+		   (t
+		    (gomoku-emacs-plays)))))))))
+
+(defun gomoku-human-takes-back ()
+  "Signal to the Gomoku program that you wish to take back your last move."
+  (interactive)
+  (gomoku-switch-to-window)
+  (cond
+   (gomoku-emacs-is-computing
+    (gomoku-crash-game))
+   ((not gomoku-game-in-progress)
+    (message "Too late for taking back...")
+    (sit-for 4)
+    (gomoku-prompt-for-other-game))
+   ((zerop gomoku-number-of-human-moves)
+    (message "You have not played yet... Your move ?"))
+   (t
+    (message "One moment, please...")
+    ;; It is possible for the user to let Emacs play several consecutive
+    ;; moves, so that the best way to know when to stop taking back moves is
+    ;; to count the number of human moves:
+    (setq gomoku-human-took-back t)
+    (let ((number gomoku-number-of-human-moves))
+      (while (= number gomoku-number-of-human-moves)
+	(gomoku-take-back)))
+    (gomoku-prompt-for-move))))
+
+(defun gomoku-human-resigns ()
+  "Signal to the Gomoku program that you may want to resign."
+  (interactive)
+  (gomoku-switch-to-window)
+  (cond
+   (gomoku-emacs-is-computing
+    (gomoku-crash-game))
+   ((not gomoku-game-in-progress)
+    (message "There is no game in progress"))
+   ((y-or-n-p "You mean, you resign ")
+    (gomoku-terminate-game 'human-resigned))
+   ((y-or-n-p "You mean, we continue ")
+    (gomoku-prompt-for-move))
+   (t
+    (gomoku-terminate-game 'human-resigned)))) ; OK. Accept it
+
+;;;
+;;; PROMPTING THE HUMAN PLAYER.
+;;;
+
+(defun gomoku-prompt-for-move ()
+  "Display a message asking for Human's move."
+  (message (if (zerop gomoku-number-of-human-moves)
+	       "Your move ? (move to a free square and hit X, RET ...)"
+	       "Your move ?"))
+  ;; This may seem silly, but if one omits the following line (or a similar
+  ;; one), the cursor may very well go to some place where POINT is not.
+  (save-excursion (set-buffer (other-buffer))))
+
+(defun gomoku-prompt-for-other-game ()
+  "Ask for another game, and start it."
+  (if (y-or-n-p "Another game ")
+      (gomoku gomoku-board-width gomoku-board-height)
+  (message "Chicken !")))
+
+(defun gomoku-offer-a-draw ()
+  "Offer a draw and return T if Human accepted it."
+  (or (y-or-n-p "I offer you a draw. Do you accept it ")
+      (prog1 (setq gomoku-human-refused-draw t)
+	nil)))
+
+;;;
+;;; DISPLAYING THE BOARD.
+;;;
+
+;; You may change these values if you have a small screen or if the squares
+;; look rectangular, but spacings SHOULD be at least 2 (MUST BE at least 1).
+
+(defconst gomoku-square-width 4
+  "*Horizontal spacing between squares on the Gomoku board.")
+
+(defconst gomoku-square-height 2
+  "*Vertical spacing between squares on the Gomoku board.")
+
+(defconst gomoku-x-offset 3
+  "*Number of columns between the Gomoku board and the side of the window.")
+
+(defconst gomoku-y-offset 1
+  "*Number of lines between the Gomoku board and the top of the window.")
+
+
+(defun gomoku-max-width ()
+  "Largest possible board width for the current window."
+  (1+ (/ (- (window-width (selected-window))
+	    gomoku-x-offset gomoku-x-offset 1)
+	 gomoku-square-width)))
+
+(defun gomoku-max-height ()
+  "Largest possible board height for the current window."
+  (1+ (/ (- (window-height (selected-window))
+	    gomoku-y-offset gomoku-y-offset 2)
+	 ;; 2 instead of 1 because WINDOW-HEIGHT includes the mode line !
+	 gomoku-square-height)))
+
+(defun gomoku-point-x ()
+  "Return the board column where point is, or nil if it is not a board column."
+  (let ((col (- (current-column) gomoku-x-offset)))
+    (if (and (>= col 0)
+	     (zerop (% col gomoku-square-width))
+	     (<= (setq col (1+ (/ col gomoku-square-width)))
+		 gomoku-board-width))
+	col)))
+
+(defun gomoku-point-y ()
+  "Return the board row where point is, or nil if it is not a board row."
+  (let ((row (- (count-lines 1 (point)) gomoku-y-offset 1)))
+    (if (and (>= row 0)
+	     (zerop (% row gomoku-square-height))
+	     (<= (setq row (1+ (/ row gomoku-square-height)))
+		 gomoku-board-height))
+	row)))
+
+(defun gomoku-point-square ()
+  "Return the index of the square point is on, or nil if not on the board."
+  (let (x y)
+    (and (setq x (gomoku-point-x))
+	 (setq y (gomoku-point-y))
+	 (gomoku-xy-to-index x y))))
+
+(defun gomoku-goto-square (index)
+  "Move point to square number INDEX."
+  (gomoku-goto-xy (gomoku-index-to-x index) (gomoku-index-to-y index)))
+
+(defun gomoku-goto-xy (x y)
+  "Move point to square at X, Y coords."
+  (goto-line (+ 1 gomoku-y-offset (* gomoku-square-height (1- y))))
+  (move-to-column (+ gomoku-x-offset (* gomoku-square-width (1- x)))))
+
+(defun gomoku-plot-square (square value)
+  "Draw 'X', 'O' or '.' on SQUARE (depending on VALUE), leave point there."
+  (gomoku-goto-square square)
+  (gomoku-put-char (cond ((= value 1) ?X)
+			 ((= value 6) ?O)
+			 (t	      ?.)))
+  (sit-for 0))	; Display NOW
+
+(defun gomoku-put-char (char)
+  "Draw CHAR on the Gomoku screen."
+  (if buffer-read-only (toggle-read-only))
+  (insert char)
+  (delete-char 1)
+  (backward-char 1)
+  (toggle-read-only))
+
+(defun gomoku-init-display (n m)
+  "Display an N by M Gomoku board."
+  (buffer-flush-undo (current-buffer))
+  (if buffer-read-only (toggle-read-only))
+  (erase-buffer)
+  (let (string1 string2 string3 string4)
+    ;; We do not use gomoku-plot-square which would be too slow for
+    ;; initializing the display. Rather we build STRING1 for lines where
+    ;; board squares are to be found, and STRING2 for empty lines. STRING1 is
+    ;; like STRING2 except for dots every DX squares. Empty lines are filled
+    ;; with spaces so that cursor moving up and down remains on the same
+    ;; column.
+    (setq string1 (concat (make-string (1- gomoku-square-width) ? ) ".")
+	  string1 (apply 'concat
+		    (make-list (1- n) string1))
+	  string1 (concat (make-string gomoku-x-offset ? ) "." string1 "\n")
+	  string2 (make-string (+ 1 gomoku-x-offset
+				  (* (1- n) gomoku-square-width))
+			       ? )
+	  string2 (concat string2 "\n")
+	  string3 (apply 'concat
+		    (make-list (1- gomoku-square-height) string2))
+	  string3 (concat string3 string1)
+	  string3 (apply 'concat
+		    (make-list (1- m) string3))
+	  string4 (apply 'concat
+		    (make-list gomoku-y-offset string2)))
+    (insert string4 string1 string3))
+  (toggle-read-only)
+  (gomoku-goto-xy (/ (1+ n) 2) (/ (1+ m) 2)) ; center of the board
+  (sit-for 0))				; Display NOW
+
+(defun gomoku-display-statistics ()
+  "Obnoxiously display some statistics about previous games in mode line."
+  ;; We store this string in the mode-line-process local variable.
+  ;; This is certainly not the cleanest way out ...
+  (setq mode-line-process
+	(cond
+	 ((not (zerop gomoku-number-of-draws))
+	  (format ": Won %d, lost %d, drew %d"
+		  gomoku-number-of-wins
+		  gomoku-number-of-losses
+		  gomoku-number-of-draws))
+	 ((not (zerop gomoku-number-of-losses))
+	  (format ": Won %d, lost %d"
+		  gomoku-number-of-wins
+		  gomoku-number-of-losses))
+	 ((zerop gomoku-number-of-wins)
+	  "")
+	 ((= 1 gomoku-number-of-wins)
+	  ": Already won one")
+	 (t
+	  (format ": Won %d in a row"
+		  gomoku-number-of-wins))))
+  ;; Then a (standard) kludgy line will force update of mode line.
+  (set-buffer-modified-p (buffer-modified-p)))
+
+(defun gomoku-switch-to-window ()
+  "Find or create the Gomoku buffer, and display it."
+  (interactive)
+  (let ((buff (get-buffer "*Gomoku*")))
+    (if buff				; Buffer exists:
+      (switch-to-buffer buff)		;   no problem.
+     (if gomoku-game-in-progress
+	 (gomoku-crash-game))		;   buffer has been killed or something
+     (switch-to-buffer "*Gomoku*")	; Anyway, start anew.
+     (gomoku-mode))))
+
+;;;
+;;; CROSSING WINNING QTUPLES.
+;;;
+
+;; When someone succeeds in filling a qtuple, we draw a line over the five
+;; corresponding squares. One problem is that the program does not know which
+;; squares ! It only knows the square where the last move has been played and
+;; who won. The solution is to scan the board along all four directions.
+
+(defvar gomoku-winning-qtuple-beg nil
+  "First square of the winning qtuple.")
+
+(defvar gomoku-winning-qtuple-end nil
+  "Last square of the winning qtuple.")
+
+(defvar gomoku-winning-qtuple-dx nil
+  "Direction of the winning qtuple (along the X axis).")
+
+(defvar gomoku-winning-qtuple-dy nil
+  "Direction of the winning qtuple (along the Y axis).")
+
+
+(defun gomoku-find-filled-qtuple (square value)
+  "Return T if SQUARE belongs to a qtuple filled with VALUEs."
+  (or (gomoku-check-filled-qtuple square value 1 0)
+      (gomoku-check-filled-qtuple square value 0 1)
+      (gomoku-check-filled-qtuple square value 1 1)
+      (gomoku-check-filled-qtuple square value -1 1)))
+
+(defun gomoku-check-filled-qtuple (square value dx dy)
+  "Return T if SQUARE belongs to a qtuple filled  with VALUEs along DX, DY."
+  ;; And record it in the WINNING-QTUPLE-... variables.
+  (let ((a 0) (b 0)
+	(left square) (right square)
+	(depl (gomoku-xy-to-index dx dy))
+	a+4)
+    (while (and (> a -4)		; stretch tuple left
+		(= value (aref gomoku-board (setq left (- left depl)))))
+      (setq a (1- a)))
+    (setq a+4 (+ a 4))
+    (while (and (< b a+4)		; stretch tuple right
+		(= value (aref gomoku-board (setq right (+ right depl)))))
+      (setq b (1+ b)))
+    (cond ((= b a+4)			; tuple length = 5 ?
+	   (setq gomoku-winning-qtuple-beg (+ square (* a depl))
+		 gomoku-winning-qtuple-end (+ square (* b depl))
+		 gomoku-winning-qtuple-dx dx
+		 gomoku-winning-qtuple-dy dy)
+	   t))))
+
+(defun gomoku-cross-winning-qtuple ()
+  "Cross winning qtuple, as found by gomoku-find-filled-qtuple."
+  (gomoku-cross-qtuple gomoku-winning-qtuple-beg
+		       gomoku-winning-qtuple-end
+		       gomoku-winning-qtuple-dx
+		       gomoku-winning-qtuple-dy))
+
+(defun gomoku-cross-qtuple (square1 square2 dx dy)
+  "Cross every square between SQUARE1 and SQUARE2 in the DX, DY direction."
+  (save-excursion			; Not moving point from last square
+    (let ((depl (gomoku-xy-to-index dx dy)))
+      ;; WARNING: this function assumes DEPL > 0 and SQUARE2 > SQUARE1
+      (while (not (= square1 square2))
+	(gomoku-goto-square square1)
+	(setq square1 (+ square1 depl))
+	(cond
+	  ((and (= dx 1) (= dy 0))	; Horizontal
+	   (let ((n 1))
+	     (while (< n gomoku-square-width)
+	       (setq n (1+ n))
+	       (forward-char 1)
+	       (gomoku-put-char ?-))))
+	  ((and (= dx 0) (= dy 1))	; Vertical
+	   (let ((n 1))
+	     (while (< n gomoku-square-height)
+	       (setq n (1+ n))
+	       (next-line 1)
+	       (gomoku-put-char ?|))))
+	  ((and (= dx -1) (= dy 1))	; 1st Diagonal
+	   (backward-char (/ gomoku-square-width 2))
+	   (next-line (/ gomoku-square-height 2))
+	   (gomoku-put-char ?/))
+	  ((and (= dx 1) (= dy 1))	; 2nd Diagonal
+	   (forward-char (/ gomoku-square-width 2))
+	   (next-line (/ gomoku-square-height 2))
+	   (gomoku-put-char ?\\))))))
+  (sit-for 0))				; Display NOW
+
+;;;
+;;; CURSOR MOTION.
+;;;
+(defun gomoku-move-left ()
+  "Move point backward one column on the Gomoku board."
+  (interactive)
+  (let ((x (gomoku-point-x)))
+    (backward-char (cond ((null x) 1)
+			 ((> x 1) gomoku-square-width)
+			 (t 0)))))
+
+(defun gomoku-move-right ()
+  "Move point forward one column on the Gomoku board."
+  (interactive)
+  (let ((x (gomoku-point-x)))
+    (forward-char (cond ((null x) 1)
+			((< x gomoku-board-width) gomoku-square-width)
+			(t 0)))))
+
+(defun gomoku-move-down ()
+  "Move point down one row on the Gomoku board."
+  (interactive)
+  (let ((y (gomoku-point-y)))
+    (next-line (cond ((null y) 1)
+		     ((< y gomoku-board-height) gomoku-square-height)
+		     (t 0)))))
+
+(defun gomoku-move-up ()
+  "Move point up one row on the Gomoku board."
+  (interactive)
+  (let ((y (gomoku-point-y)))
+    (previous-line (cond ((null y) 1)
+			 ((> y 1) gomoku-square-height)
+			 (t 0)))))
+
+(defun gomoku-move-ne ()
+  "Move point North East on the Gomoku board."
+  (interactive)
+  (gomoku-move-up)
+  (gomoku-move-right))
+
+(defun gomoku-move-se ()
+  "Move point South East on the Gomoku board."
+  (interactive)
+  (gomoku-move-down)
+  (gomoku-move-right))
+
+(defun gomoku-move-nw ()
+  "Move point North West on the Gomoku board."
+  (interactive)
+  (gomoku-move-up)
+  (gomoku-move-left))
+
+(defun gomoku-move-sw ()
+  "Move point South West on the Gomoku board."
+  (interactive)
+  (gomoku-move-down)
+  (gomoku-move-left))
+
+
diff --git a/lisp/play/spook.el b/lisp/play/spook.el
new file mode 100644
index 0000000000..84fffceeaa
--- /dev/null
+++ b/lisp/play/spook.el
@@ -0,0 +1,109 @@
+;; Spook phrase utility
+;; Copyright (C) 1988 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+; Steve Strassmann (straz@media-lab.media.mit.edu) didn't write
+; this, and even if he did, he really didn't mean for you to use it
+; in an anarchistic way.
+; May 1987
+
+; To use this:
+;  Make sure you have the variable SPOOK-PHRASES-FILE pointing to 
+;  a valid phrase file. Phrase files are in the same format as
+;  zippy's yow.lines (ITS-style LINS format). 
+;  Strings are terminated by ascii 0 characters. Leading whitespace ignored.
+;  Everything up to the first \000 is a comment.
+;
+;  Just before sending mail, do M-x spook.
+;  A number of phrases will be inserted into your buffer, to help
+;  give your message that extra bit of attractiveness for automated
+;  keyword scanners.
+
+; Variables
+(defvar spook-phrases-file (concat exec-directory "spook.lines")
+   "Keep your favorite phrases here.")
+
+(defvar spook-phrase-default-count 15
+   "Default number of phrases to insert")
+
+(defvar spook-vector nil
+  "Important phrases for NSA mail-watchers")
+
+; Randomize the seed in the random number generator.
+(random t)
+
+; Call this with M-x spook.
+(defun spook ()
+  "Adds that special touch of class to your outgoing mail."
+  (interactive)
+  (if (null spook-vector)
+      (setq spook-vector (snarf-spooks)))
+  (shuffle-vector spook-vector)
+  (let ((start (point)))
+    (insert ?\n)
+    (spook1 (min (- (length spook-vector) 1) spook-phrase-default-count))
+    (insert ?\n)
+    (fill-region-as-paragraph start (point) nil)))
+
+(defun spook1 (arg)
+  "Inserts a spook phrase ARG times."
+  (cond ((zerop arg) t)
+	(t (insert (aref spook-vector arg))
+	   (insert " ")
+	   (spook1 (1- arg)))))
+
+(defun snarf-spooks ()
+  "Reads in the phrase file"
+  (message "Checking authorization...")
+  (save-excursion
+    (let ((buf (generate-new-buffer "*spook*"))
+	  (result '()))
+      (set-buffer buf)
+      (insert-file-contents (expand-file-name spook-phrases-file))
+      (search-forward "\0")
+      (while (progn (skip-chars-forward " \t\n\r\f") (not (eobp)))
+	(let ((beg (point)))
+	  (search-forward "\0")
+	  (setq result (cons (buffer-substring beg (1- (point)))
+			     result))))
+      (kill-buffer buf)
+      (message "Checking authorization... Approved.")
+      (setq spook-vector (apply 'vector result)))))
+
+(defun pick-random (n)
+  "Returns a random number from 0 to N-1 inclusive."
+  (% (logand 0777777 (random)) n))
+
+; Thanks to Ian G Batten <BattenIG@CS.BHAM.AC.UK>
+; [of the University of Birmingham Computer Science Department]
+; for the iterative version of this shuffle.
+;
+(defun shuffle-vector (vector)
+  "Randomly permute the elements of VECTOR (all permutations equally likely)"
+  (let ((i 0)
+	j
+	temp
+	(len (length vector)))
+    (while (< i len)
+      (setq j (+ i (pick-random (- len i))))
+      (setq temp (aref vector i))
+      (aset vector i (aref vector j))
+      (aset vector j temp)
+      (setq i (1+ i))))
+  vector)
diff --git a/lisp/progmodes/icon.el b/lisp/progmodes/icon.el
new file mode 100644
index 0000000000..2215f84d79
--- /dev/null
+++ b/lisp/progmodes/icon.el
@@ -0,0 +1,550 @@
+;; Note: use
+;;  (autoload 'icon-mode "icon" nil t)
+;;  (setq auto-mode-alist (cons '("\\.icn$" . icon-mode) auto-mode-alist))
+;; if not permanently installed in your emacs
+
+;; Icon code editing commands for Emacs
+;; Derived from c-mode.el  15-Feb-89  Chris Smith  convex!csmith
+;; Copyright (C) 1989 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+(defvar icon-mode-abbrev-table nil
+  "Abbrev table in use in Icon-mode buffers.")
+(define-abbrev-table 'icon-mode-abbrev-table ())
+
+(defvar icon-mode-map ()
+  "Keymap used in Icon mode.")
+(if icon-mode-map
+    ()
+  (setq icon-mode-map (make-sparse-keymap))
+  (define-key icon-mode-map "{" 'electric-icon-brace)
+  (define-key icon-mode-map "}" 'electric-icon-brace)
+  (define-key icon-mode-map "\e\C-h" 'mark-icon-function)
+  (define-key icon-mode-map "\e\C-a" 'beginning-of-icon-defun)
+  (define-key icon-mode-map "\e\C-e" 'end-of-icon-defun)
+  (define-key icon-mode-map "\e\C-q" 'indent-icon-exp)
+  (define-key icon-mode-map "\177" 'backward-delete-char-untabify)
+  (define-key icon-mode-map "\t" 'icon-indent-command))
+
+(defvar icon-mode-syntax-table nil
+  "Syntax table in use in Icon-mode buffers.")
+
+(if icon-mode-syntax-table
+    ()
+  (setq icon-mode-syntax-table (make-syntax-table))
+  (modify-syntax-entry ?\\ "\\" icon-mode-syntax-table)
+  (modify-syntax-entry ?# "<" icon-mode-syntax-table)
+  (modify-syntax-entry ?\n ">" icon-mode-syntax-table)
+  (modify-syntax-entry ?$ "." icon-mode-syntax-table)
+  (modify-syntax-entry ?/ "." icon-mode-syntax-table)
+  (modify-syntax-entry ?* "." icon-mode-syntax-table)
+  (modify-syntax-entry ?+ "." icon-mode-syntax-table)
+  (modify-syntax-entry ?- "." icon-mode-syntax-table)
+  (modify-syntax-entry ?= "." icon-mode-syntax-table)
+  (modify-syntax-entry ?% "." icon-mode-syntax-table)
+  (modify-syntax-entry ?< "." icon-mode-syntax-table)
+  (modify-syntax-entry ?> "." icon-mode-syntax-table)
+  (modify-syntax-entry ?& "." icon-mode-syntax-table)
+  (modify-syntax-entry ?| "." icon-mode-syntax-table)
+  (modify-syntax-entry ?\' "\"" icon-mode-syntax-table))
+
+(defconst icon-indent-level 4
+  "*Indentation of Icon statements with respect to containing block.")
+(defconst icon-brace-imaginary-offset 0
+  "*Imagined indentation of a Icon open brace that actually follows a statement.")
+(defconst icon-brace-offset 0
+  "*Extra indentation for braces, compared with other text in same context.")
+(defconst icon-continued-statement-offset 4
+  "*Extra indent for lines not starting new statements.")
+(defconst icon-continued-brace-offset 0
+  "*Extra indent for substatements that start with open-braces.
+This is in addition to icon-continued-statement-offset.")
+
+(defconst icon-auto-newline nil
+  "*Non-nil means automatically newline before and after braces
+inserted in Icon code.")
+
+(defconst icon-tab-always-indent t
+  "*Non-nil means TAB in Icon mode should always reindent the current line,
+regardless of where in the line point is when the TAB command is used.")
+
+(defun icon-mode ()
+  "Major mode for editing Icon code.
+Expression and list commands understand all Icon brackets.
+Tab indents for Icon code.
+Paragraphs are separated by blank lines only.
+Delete converts tabs to spaces as it moves back.
+\\{icon-mode-map}
+Variables controlling indentation style:
+ icon-tab-always-indent
+    Non-nil means TAB in Icon mode should always reindent the current line,
+    regardless of where in the line point is when the TAB command is used.
+ icon-auto-newline
+    Non-nil means automatically newline before and after braces
+    inserted in Icon code.
+ icon-indent-level
+    Indentation of Icon statements within surrounding block.
+    The surrounding block's indentation is the indentation
+    of the line on which the open-brace appears.
+ icon-continued-statement-offset
+    Extra indentation given to a substatement, such as the
+    then-clause of an if or body of a while.
+ icon-continued-brace-offset
+    Extra indentation given to a brace that starts a substatement.
+    This is in addition to icon-continued-statement-offset.
+ icon-brace-offset
+    Extra indentation for line if it starts with an open brace.
+ icon-brace-imaginary-offset
+    An open brace following other text is treated as if it were
+    this far to the right of the start of its line.
+
+Turning on Icon mode calls the value of the variable icon-mode-hook with no args,
+if that value is non-nil."
+  (interactive)
+  (kill-all-local-variables)
+  (use-local-map icon-mode-map)
+  (setq major-mode 'icon-mode)
+  (setq mode-name "Icon")
+  (setq local-abbrev-table icon-mode-abbrev-table)
+  (set-syntax-table icon-mode-syntax-table)
+  (make-local-variable 'paragraph-start)
+  (setq paragraph-start (concat "^$\\|" page-delimiter))
+  (make-local-variable 'paragraph-separate)
+  (setq paragraph-separate paragraph-start)
+  (make-local-variable 'indent-line-function)
+  (setq indent-line-function 'icon-indent-line)
+  (make-local-variable 'require-final-newline)
+  (setq require-final-newline t)
+  (make-local-variable 'comment-start)
+  (setq comment-start "# ")
+  (make-local-variable 'comment-end)
+  (setq comment-end "")
+  (make-local-variable 'comment-column)
+  (setq comment-column 32)
+  (make-local-variable 'comment-start-skip)
+  (setq comment-start-skip "# *")
+  (make-local-variable 'comment-indent-hook)
+  (setq comment-indent-hook 'icon-comment-indent)
+  (run-hooks 'icon-mode-hook))
+
+;; This is used by indent-for-comment
+;; to decide how much to indent a comment in Icon code
+;; based on its context.
+(defun icon-comment-indent ()
+  (if (looking-at "^#")
+      0	
+    (save-excursion
+      (skip-chars-backward " \t")
+      (max (if (bolp) 0 (1+ (current-column)))
+	   comment-column))))
+
+(defun electric-icon-brace (arg)
+  "Insert character and correct line's indentation."
+  (interactive "P")
+  (let (insertpos)
+    (if (and (not arg)
+	     (eolp)
+	     (or (save-excursion
+		   (skip-chars-backward " \t")
+		   (bolp))
+		 (if icon-auto-newline
+		     (progn (icon-indent-line) (newline) t)
+		   nil)))
+	(progn
+	  (insert last-command-char)
+	  (icon-indent-line)
+	  (if icon-auto-newline
+	      (progn
+		(newline)
+		;; (newline) may have done auto-fill
+		(setq insertpos (- (point) 2))
+		(icon-indent-line)))
+	  (save-excursion
+	    (if insertpos (goto-char (1+ insertpos)))
+	    (delete-char -1))))
+    (if insertpos
+	(save-excursion
+	  (goto-char insertpos)
+	  (self-insert-command (prefix-numeric-value arg)))
+      (self-insert-command (prefix-numeric-value arg)))))
+
+(defun icon-indent-command (&optional whole-exp)
+  (interactive "P")
+  "Indent current line as Icon code, or in some cases insert a tab character.
+If icon-tab-always-indent is non-nil (the default), always indent current line.
+Otherwise, indent the current line only if point is at the left margin
+or in the line's indentation; otherwise insert a tab.
+
+A numeric argument, regardless of its value,
+means indent rigidly all the lines of the expression starting after point
+so that this line becomes properly indented.
+The relative indentation among the lines of the expression are preserved."
+  (if whole-exp
+      ;; If arg, always indent this line as Icon
+      ;; and shift remaining lines of expression the same amount.
+      (let ((shift-amt (icon-indent-line))
+	    beg end)
+	(save-excursion
+	  (if icon-tab-always-indent
+	      (beginning-of-line))
+	  (setq beg (point))
+	  (forward-sexp 1)
+	  (setq end (point))
+	  (goto-char beg)
+	  (forward-line 1)
+	  (setq beg (point)))
+	(if (> end beg)
+	    (indent-code-rigidly beg end shift-amt "#")))
+    (if (and (not icon-tab-always-indent)
+	     (save-excursion
+	       (skip-chars-backward " \t")
+	       (not (bolp))))
+	(insert-tab)
+      (icon-indent-line))))
+
+(defun icon-indent-line ()
+  "Indent current line as Icon code.
+Return the amount the indentation changed by."
+  (let ((indent (calculate-icon-indent nil))
+	beg shift-amt
+	(case-fold-search nil)
+	(pos (- (point-max) (point))))
+    (beginning-of-line)
+    (setq beg (point))
+    (cond ((eq indent nil)
+	   (setq indent (current-indentation)))
+	  ((eq indent t)
+	   (setq indent (calculate-icon-indent-within-comment)))
+	  ((looking-at "[ \t]*#")
+	   (setq indent 0))
+	  (t
+	   (skip-chars-forward " \t")
+	   (if (listp indent) (setq indent (car indent)))
+	   (cond ((and (looking-at "else\\b")
+		       (not (looking-at "else\\s_")))
+		  (setq indent (save-excursion
+				 (icon-backward-to-start-of-if)
+				 (current-indentation))))
+		 ((or (= (following-char) ?})
+		      (looking-at "end\\b"))
+		  (setq indent (- indent icon-indent-level)))
+		 ((= (following-char) ?{)
+		  (setq indent (+ indent icon-brace-offset))))))
+    (skip-chars-forward " \t")
+    (setq shift-amt (- indent (current-column)))
+    (if (zerop shift-amt)
+	(if (> (- (point-max) pos) (point))
+	    (goto-char (- (point-max) pos)))
+      (delete-region beg (point))
+      (indent-to indent)
+      ;; If initial point was within line's indentation,
+      ;; position after the indentation.  Else stay at same point in text.
+      (if (> (- (point-max) pos) (point))
+	  (goto-char (- (point-max) pos))))
+    shift-amt))
+
+(defun calculate-icon-indent (&optional parse-start)
+  "Return appropriate indentation for current line as Icon code.
+In usual case returns an integer: the column to indent to.
+Returns nil if line starts inside a string, t if in a comment."
+  (save-excursion
+    (beginning-of-line)
+    (let ((indent-point (point))
+	  (case-fold-search nil)
+	  state
+	  containing-sexp
+	  toplevel)
+      (if parse-start
+	  (goto-char parse-start)
+	(setq toplevel (beginning-of-icon-defun)))
+      (while (< (point) indent-point)
+	(setq parse-start (point))
+	(setq state (parse-partial-sexp (point) indent-point 0))
+	(setq containing-sexp (car (cdr state))))
+      (cond ((or (nth 3 state) (nth 4 state))
+	     ;; return nil or t if should not change this line
+	     (nth 4 state))
+	    ((and containing-sexp
+		  (/= (char-after containing-sexp) ?{))
+	     ;; line is expression, not statement:
+	     ;; indent to just after the surrounding open.
+	     (goto-char (1+ containing-sexp))
+	     (current-column))
+	    (t
+	      (if toplevel
+		  ;; Outside any procedures.
+		  (progn (icon-backward-to-noncomment (point-min))
+			 (if (icon-is-continuation-line)
+			     icon-continued-statement-offset 0))
+		;; Statement level.
+		(if (null containing-sexp)
+		    (progn (beginning-of-icon-defun)
+			   (setq containing-sexp (point))))
+		(goto-char indent-point)
+		;; Is it a continuation or a new statement?
+		;; Find previous non-comment character.
+		(icon-backward-to-noncomment containing-sexp)
+		;; Now we get the answer.
+		(if (icon-is-continuation-line)
+		    ;; This line is continuation of preceding line's statement;
+		    ;; indent  icon-continued-statement-offset  more than the
+		    ;; first line of the statement.
+		    (progn
+		      (icon-backward-to-start-of-continued-exp containing-sexp)
+		      (+ icon-continued-statement-offset (current-column)
+			 (if (save-excursion (goto-char indent-point)
+					     (skip-chars-forward " \t")
+					     (eq (following-char) ?{))
+			     icon-continued-brace-offset 0)))
+		  ;; This line starts a new statement.
+		  ;; Position following last unclosed open.
+		  (goto-char containing-sexp)
+		  ;; Is line first statement after an open-brace?
+		  (or
+		    ;; If no, find that first statement and indent like it.
+		    (save-excursion
+		      (if (looking-at "procedure\\s ")
+			  (forward-sexp 3)
+			(forward-char 1))
+		      (while (progn (skip-chars-forward " \t\n")
+				    (looking-at "#"))
+			;; Skip over comments following openbrace.
+			(forward-line 1))
+		      ;; The first following code counts
+		      ;; if it is before the line we want to indent.
+		      (and (< (point) indent-point)
+			   (current-column)))
+		    ;; If no previous statement,
+		    ;; indent it relative to line brace is on.
+		    ;; For open brace in column zero, don't let statement
+		    ;; start there too.  If icon-indent-level is zero,
+		    ;; use icon-brace-offset + icon-continued-statement-offset
+		    ;; instead.
+		    ;; For open-braces not the first thing in a line,
+		    ;; add in icon-brace-imaginary-offset.
+		    (+ (if (and (bolp) (zerop icon-indent-level))
+			   (+ icon-brace-offset
+			      icon-continued-statement-offset)
+			 icon-indent-level)
+		       ;; Move back over whitespace before the openbrace.
+		       ;; If openbrace is not first nonwhite thing on the line,
+		       ;; add the icon-brace-imaginary-offset.
+		       (progn (skip-chars-backward " \t")
+			      (if (bolp) 0 icon-brace-imaginary-offset))
+		       ;; Get initial indentation of the line we are on.
+		       (current-indentation))))))))))
+
+;; List of words to check for as the last thing on a line.
+;; If cdr is t, next line is a continuation of the same statement,
+;; if cdr is nil, next line starts a new (possibly indented) statement.
+
+(defconst icon-resword-alist
+  '(("by" . t) ("case" . t) ("create") ("do") ("dynamic" . t) ("else")
+    ("every" . t) ("if" . t) ("global" . t) ("initial" . t)
+    ("link" . t) ("local" . t) ("of") ("record" . t) ("repeat" . t)
+    ("static" . t) ("then") ("to" . t) ("until" . t) ("while" . t)))
+
+(defun icon-is-continuation-line ()
+  (let* ((ch (preceding-char))
+	 (ch-syntax (char-syntax ch)))
+    (if (eq ch-syntax ?w)
+	(assoc (buffer-substring
+		(progn (forward-word -1) (point))
+		(progn (forward-word 1) (point)))
+	       icon-resword-alist)
+      (not (memq ch '(0 ?\; ?\} ?\{ ?\) ?\] ?\" ?\' ?\n))))))
+
+(defun icon-backward-to-noncomment (lim)
+  (let (opoint stop)
+    (while (not stop)
+      (skip-chars-backward " \t\n\f" lim)
+      (setq opoint (point))
+      (beginning-of-line)
+      (if (and (nth 5 (parse-partial-sexp (point) opoint))
+	       (< lim (point)))
+	  (search-backward "#")
+	(setq stop t)))))
+
+(defun icon-backward-to-start-of-continued-exp (lim)
+  (if (memq (preceding-char) '(?\) ?\]))
+      (forward-sexp -1))
+  (beginning-of-line)
+  (skip-chars-forward " \t")
+  (cond
+   ((<= (point) lim) (goto-char (1+ lim)))
+   ((not (icon-is-continued-line)) 0)
+   ((and (eq (char-syntax (following-char)) ?w)
+	 (cdr
+	  (assoc (buffer-substring (point)
+				   (save-excursion (forward-word 1) (point)))
+		 icon-resword-alist))) 0)
+   (t (end-of-line 0) (icon-backward-to-start-of-continued-exp lim))))
+
+(defun icon-is-continued-line ()
+  (save-excursion
+    (end-of-line 0)
+    (icon-is-continuation-line)))
+
+(defun icon-backward-to-start-of-if (&optional limit)
+  "Move to the start of the last ``unbalanced'' if."
+  (or limit (setq limit (save-excursion (beginning-of-icon-defun) (point))))
+  (let ((if-level 1)
+	(case-fold-search nil))
+    (while (not (zerop if-level))
+      (backward-sexp 1)
+      (cond ((looking-at "else\\b")
+	     (setq if-level (1+ if-level)))
+	    ((looking-at "if\\b")
+	     (setq if-level (1- if-level)))
+	    ((< (point) limit)
+	     (setq if-level 0)
+	     (goto-char limit))))))
+
+(defun mark-icon-function ()
+  "Put mark at end of Icon function, point at beginning."
+  (interactive)
+  (push-mark (point))
+  (end-of-icon-defun)
+  (push-mark (point))
+  (beginning-of-line 0)
+  (beginning-of-icon-defun))
+
+(defun beginning-of-icon-defun ()
+  "Go to the start of the enclosing procedure; return t if at top level."
+  (interactive)
+  (if (re-search-backward "^procedure\\s \\|^end[ \t\n]" (point-min) 'move)
+      (looking-at "e")
+    t))
+
+(defun end-of-icon-defun ()
+  (interactive)
+  (if (not (bobp)) (forward-char -1))
+  (re-search-forward "\\(\\s \\|^\\)end\\(\\s \\|$\\)" (point-max) 'move)
+  (forward-word -1)
+  (forward-line 1))
+
+(defun indent-icon-exp ()
+  "Indent each line of the Icon grouping following point."
+  (interactive)
+  (let ((indent-stack (list nil))
+	(contain-stack (list (point)))
+	(case-fold-search nil)
+	restart outer-loop-done inner-loop-done state ostate
+	this-indent last-sexp
+	at-else at-brace at-do
+	(opoint (point))
+	(next-depth 0))
+    (save-excursion
+      (forward-sexp 1))
+    (save-excursion
+      (setq outer-loop-done nil)
+      (while (and (not (eobp)) (not outer-loop-done))
+	(setq last-depth next-depth)
+	;; Compute how depth changes over this line
+	;; plus enough other lines to get to one that
+	;; does not end inside a comment or string.
+	;; Meanwhile, do appropriate indentation on comment lines.
+	(setq innerloop-done nil)
+	(while (and (not innerloop-done)
+		    (not (and (eobp) (setq outer-loop-done t))))
+	  (setq ostate state)
+	  (setq state (parse-partial-sexp (point) (progn (end-of-line) (point))
+					  nil nil state))
+	  (setq next-depth (car state))
+	  (if (and (car (cdr (cdr state)))
+		   (>= (car (cdr (cdr state))) 0))
+	      (setq last-sexp (car (cdr (cdr state)))))
+	  (if (or (nth 4 ostate))
+	      (icon-indent-line))
+	  (if (or (nth 3 state))
+	      (forward-line 1)
+	    (setq innerloop-done t)))
+	(if (<= next-depth 0)
+	    (setq outer-loop-done t))
+	(if outer-loop-done
+	    nil
+	  (if (/= last-depth next-depth)
+	      (setq last-sexp nil))
+	  (while (> last-depth next-depth)
+	    (setq indent-stack (cdr indent-stack)
+		  contain-stack (cdr contain-stack)
+		  last-depth (1- last-depth)))
+	  (while (< last-depth next-depth)
+	    (setq indent-stack (cons nil indent-stack)
+		  contain-stack (cons nil contain-stack)
+		  last-depth (1+ last-depth)))
+	  (if (null (car contain-stack))
+	      (setcar contain-stack (or (car (cdr state))
+					(save-excursion (forward-sexp -1)
+							(point)))))
+	  (forward-line 1)
+	  (skip-chars-forward " \t")
+	  (if (eolp)
+	      nil
+	    (if (and (car indent-stack)
+		     (>= (car indent-stack) 0))
+		;; Line is on an existing nesting level.
+		;; Lines inside parens are handled specially.
+		(if (/= (char-after (car contain-stack)) ?{)
+		    (setq this-indent (car indent-stack))
+		  ;; Line is at statement level.
+		  ;; Is it a new statement?  Is it an else?
+		  ;; Find last non-comment character before this line
+		  (save-excursion
+		    (setq at-else (looking-at "else\\W"))
+		    (setq at-brace (= (following-char) ?{))
+		    (icon-backward-to-noncomment opoint)
+		    (if (icon-is-continuation-line)
+			;; Preceding line did not end in comma or semi;
+			;; indent this line  icon-continued-statement-offset
+			;; more than previous.
+			(progn
+			  (icon-backward-to-start-of-continued-exp (car contain-stack))
+			  (setq this-indent
+				(+ icon-continued-statement-offset (current-column)
+				   (if at-brace icon-continued-brace-offset 0))))
+		      ;; Preceding line ended in comma or semi;
+		      ;; use the standard indent for this level.
+		      (if at-else
+			  (progn (icon-backward-to-start-of-if opoint)
+				 (setq this-indent (current-indentation)))
+			(setq this-indent (car indent-stack))))))
+	      ;; Just started a new nesting level.
+	      ;; Compute the standard indent for this level.
+	      (let ((val (calculate-icon-indent
+			   (if (car indent-stack)
+			       (- (car indent-stack))))))
+		(setcar indent-stack
+			(setq this-indent val))))
+	    ;; Adjust line indentation according to its contents
+	    (if (or (= (following-char) ?})
+		    (looking-at "end\\b"))
+		(setq this-indent (- this-indent icon-indent-level)))
+	    (if (= (following-char) ?{)
+		(setq this-indent (+ this-indent icon-brace-offset)))
+	    ;; Put chosen indentation into effect.
+	    (or (= (current-column) this-indent)
+		(progn
+		  (delete-region (point) (progn (beginning-of-line) (point)))
+		  (indent-to this-indent)))
+	    ;; Indent any comment following the text.
+	    (or (looking-at comment-start-skip)
+		(if (re-search-forward comment-start-skip (save-excursion (end-of-line) (point)) t)
+		    (progn (indent-for-comment) (beginning-of-line))))))))))
+
diff --git a/lisp/rect.el b/lisp/rect.el
new file mode 100644
index 0000000000..3dd06f1be0
--- /dev/null
+++ b/lisp/rect.el
@@ -0,0 +1,205 @@
+;; Rectangle functions for GNU Emacs.
+;; Copyright (C) 1985 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+(defun operate-on-rectangle (function start end coerce-tabs)
+  "Call FUNCTION for each line of rectangle with corners at START, END.
+If COERCE-TABS is non-nil, convert multi-column characters
+that span the starting or ending columns on any line
+to multiple spaces before calling FUNCTION.
+FUNCTION is called with three arguments:
+ position of start of segment of this line within the rectangle,
+ number of columns that belong to rectangle but are before that position,
+ number of columns that belong to rectangle but are after point.
+Point is at the end of the segment of this line within the rectangle."
+  (let (startcol startlinepos endcol endlinepos)
+    (save-excursion
+     (goto-char start)
+     (setq startcol (current-column))
+     (beginning-of-line)
+     (setq startlinepos (point)))
+    (save-excursion
+     (goto-char end)
+     (setq endcol (current-column))
+     (forward-line 1)
+     (setq endlinepos (point-marker)))
+    (if (< endcol startcol)
+	(let ((tem startcol))
+	  (setq startcol endcol endcol tem)))
+    (if (/= endcol startcol)
+	(save-excursion
+	 (goto-char startlinepos)
+	 (while (< (point) endlinepos)
+	   (let (startpos begextra endextra)
+	     (move-to-column startcol)
+	     (and coerce-tabs
+		  (> (current-column) startcol)
+		  (rectangle-coerce-tab startcol))
+	     (setq begextra (- (current-column) startcol))
+	     (setq startpos (point))
+	     (move-to-column endcol)
+	     (if (> (current-column) endcol)
+		 (if coerce-tabs
+		     (rectangle-coerce-tab endcol)
+		   (forward-char -1)))
+	     (setq endextra (- endcol (current-column)))
+	     (if (< begextra 0)
+		 (setq endextra (+ endextra begextra)
+		       begextra 0))
+	     (funcall function startpos begextra endextra))
+	   (forward-line 1))))
+    (- endcol startcol)))
+
+(defun delete-rectangle-line (startdelpos ignore ignore)
+  (delete-region startdelpos (point)))
+
+(defun delete-extract-rectangle-line (startdelpos begextra endextra)
+  (save-excursion
+   (extract-rectangle-line startdelpos begextra endextra))
+  (delete-region startdelpos (point)))
+
+(defun extract-rectangle-line (startdelpos begextra endextra)
+  (let ((line (buffer-substring startdelpos (point)))
+	(end (point)))
+    (goto-char startdelpos)
+    (while (search-forward "\t" end t)
+      (let ((width (- (current-column)
+		      (save-excursion (forward-char -1)
+				      (current-column)))))
+	(setq line (concat (substring line 0 (- (point) end 1))
+			   (spaces-string width)
+			   (substring line (+ (length line) (- (point) end)))))))
+    (if (or (> begextra 0) (> endextra 0))
+	(setq line (concat (spaces-string begextra)
+			   line
+			   (spaces-string endextra))))
+    (setq lines (cons line lines))))
+
+(defconst spaces-strings
+  '["" " " "  " "   " "    " "     " "      " "       " "        "])
+
+(defun spaces-string (n)
+  (if (<= n 8) (aref spaces-strings n)
+    (let ((val ""))
+      (while (> n 8)
+	(setq val (concat "        " val)
+	      n (- n 8)))
+      (concat val (aref spaces-strings n)))))
+    
+(defun delete-rectangle (start end)
+  "Delete (don't save) text in rectangle with point and mark as corners.
+The same range of columns is deleted in each line
+starting with the line where the region begins
+and ending with the line where the region ends."
+  (interactive "r")
+  (operate-on-rectangle 'delete-rectangle-line start end t))
+
+(defun delete-extract-rectangle (start end)
+  "Delete contents of rectangle and return it as a list of strings.
+Arguments START and END are the corners of the rectangle.
+The value is list of strings, one for each line of the rectangle."
+  (let (lines)
+    (operate-on-rectangle 'delete-extract-rectangle-line
+			  start end t)
+    (nreverse lines)))
+
+(defun extract-rectangle (start end)
+  "Return contents of rectangle with corners at START and END.
+Value is list of strings, one for each line of the rectangle."
+  (let (lines)
+    (operate-on-rectangle 'extract-rectangle-line start end nil)
+    (nreverse lines)))
+
+(defvar killed-rectangle nil
+  "Rectangle for yank-rectangle to insert.")
+
+(defun kill-rectangle (start end)
+  "Delete rectangle with corners at point and mark; save as last killed one.
+Calling from program, supply two args START and END, buffer positions.
+But in programs you might prefer to use delete-extract-rectangle."
+  (interactive "r")
+  (setq killed-rectangle (delete-extract-rectangle start end)))
+
+(defun yank-rectangle ()
+  "Yank the last killed rectangle with upper left corner at point."
+  (interactive)
+  (insert-rectangle killed-rectangle))
+
+(defun insert-rectangle (rectangle)
+  "Insert text of RECTANGLE with upper left corner at point.
+RECTANGLE's first line is inserted at point,
+its second line is inserted at a point vertically under point, etc.
+RECTANGLE should be a list of strings."
+  (let ((lines rectangle)
+	(insertcolumn (current-column))
+	(first t))
+    (while lines
+      (or first
+	  (progn
+	   (forward-line 1)
+	   (or (bolp) (insert ?\n))
+	   (move-to-column insertcolumn)
+	   (if (> (current-column) insertcolumn)
+	       (rectangle-coerce-tab insertcolumn))
+	   (if (< (current-column) insertcolumn)
+	       (indent-to insertcolumn))))
+      (setq first nil)
+      (insert (car lines))
+      (setq lines (cdr lines)))))
+
+(defun open-rectangle (start end)
+  "Blank out rectangle with corners at point and mark, shifting text right.
+The text previously in the region is not overwritten by the blanks,
+but insted winds up to the right of the rectangle."
+  (interactive "r")
+  (operate-on-rectangle 'open-rectangle-line start end nil))
+
+(defun open-rectangle-line (startpos begextra endextra)
+  (let ((column (+ (current-column) begextra endextra)))
+    (goto-char startpos)
+    (let ((ocol (current-column)))
+      (skip-chars-forward " \t")
+      (setq column (+ column (- (current-column) ocol))))
+    (delete-region (point)
+                   (progn (skip-chars-backward " \t")
+			  (point)))
+    (indent-to column)))
+
+(defun clear-rectangle (start end)
+  "Blank out rectangle with corners at point and mark.
+The text previously in the region is overwritten by the blanks.
+When called from a program, requires two args which specify the corners."
+  (interactive "r")
+  (operate-on-rectangle 'clear-rectangle-line start end t))
+
+(defun clear-rectangle-line (startpos begextra endextra)
+  (skip-chars-forward " \t")
+  (let ((column (+ (current-column) endextra)))
+    (delete-region (point)
+                   (progn (goto-char startpos)
+			  (skip-chars-backward " \t")
+			  (point)))
+    (indent-to column)))
+
+(defun rectangle-coerce-tab (column)
+  (let ((aftercol (current-column))
+	(indent-tabs-mode nil))
+    (delete-char -1)
+    (indent-to aftercol)
+    (backward-char (- aftercol column))))
diff --git a/lisp/tabify.el b/lisp/tabify.el
new file mode 100644
index 0000000000..2d660c82c6
--- /dev/null
+++ b/lisp/tabify.el
@@ -0,0 +1,51 @@
+;; Tab conversion commands for Emacs
+;; Copyright (C) 1985 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+(defun untabify (start end)
+  "Convert all tabs in region to multiple spaces, preserving columns.
+The variable tab-width controls the action."
+  (interactive "r")
+  (save-excursion
+    (save-restriction
+      (narrow-to-region start end)
+      (goto-char start)
+      (while (search-forward "\t" nil t)	; faster than re-search
+	(let ((start (point))
+	      (column (current-column))
+	      (indent-tabs-mode nil))
+	  (skip-chars-backward "\t")
+	  (delete-region start (point))
+	  (indent-to column))))))
+
+(defun tabify (start end)
+  "Convert multiple spaces in region to tabs when possible.
+A group of spaces is partially replaced by tabs
+when this can be done without changing the column they end at.
+The variable tab-width controls the action."
+  (interactive "r")
+  (save-excursion
+    (save-restriction
+      (narrow-to-region start end)
+      (goto-char start)
+      (while (re-search-forward "[ \t][ \t][ \t]*" nil t)
+	(let ((column (current-column))
+	      (indent-tabs-mode t))
+	  (delete-region (match-beginning 0) (point))
+	  (indent-to column))))))
diff --git a/lisp/textmodes/nroff-mode.el b/lisp/textmodes/nroff-mode.el
new file mode 100644
index 0000000000..16e1445080
--- /dev/null
+++ b/lisp/textmodes/nroff-mode.el
@@ -0,0 +1,203 @@
+;; GNU Emacs major mode for editing nroff source
+;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+
+(defvar nroff-mode-abbrev-table nil
+  "Abbrev table used while in nroff mode.")
+
+(defvar nroff-mode-map nil
+     "Major mode keymap for nroff-mode buffers")
+(if (not nroff-mode-map)
+    (progn
+      (setq nroff-mode-map (make-sparse-keymap))
+      (define-key nroff-mode-map "\t"  'tab-to-tab-stop)
+      (define-key nroff-mode-map "\es" 'center-line)
+      (define-key nroff-mode-map "\e?" 'count-text-lines)
+      (define-key nroff-mode-map "\n"  'electric-nroff-newline)
+      (define-key nroff-mode-map "\en" 'forward-text-line)
+      (define-key nroff-mode-map "\ep" 'backward-text-line)))
+
+(defun nroff-mode ()
+  "Major mode for editing text intended for nroff to format.
+\\{nroff-mode-map}
+Turning on Nroff mode runs text-mode-hook, then nroff-mode-hook.
+Also, try nroff-electric-mode, for automatically inserting
+closing requests for requests that are used in matched pairs."
+  (interactive)
+  (kill-all-local-variables)
+  (use-local-map nroff-mode-map)
+  (setq mode-name "Nroff")
+  (setq major-mode 'nroff-mode)
+  (set-syntax-table text-mode-syntax-table)
+  (setq local-abbrev-table nroff-mode-abbrev-table)
+  (make-local-variable 'nroff-electric-mode)
+  ;; now define a bunch of variables for use by commands in this mode
+  (make-local-variable 'page-delimiter)
+  (setq page-delimiter "^\\.\\(bp\\|SK\\|OP\\)")
+  (make-local-variable 'paragraph-start)
+  (setq paragraph-start (concat "^[.']\\|" paragraph-start))
+  (make-local-variable 'paragraph-separate)
+  (setq paragraph-separate (concat "^[.']\\|" paragraph-separate))
+  ;; comment syntax added by mit-erl!gildea 18 Apr 86
+  (make-local-variable 'comment-start)
+  (setq comment-start "\\\" ")
+  (make-local-variable 'comment-start-skip)
+  (setq comment-start-skip "\\\\\"[ \t]*")
+  (make-local-variable 'comment-column)
+  (setq comment-column 24)
+  (make-local-variable 'comment-indent-hook)
+  (setq comment-indent-hook 'nroff-comment-indent)
+  (run-hooks 'text-mode-hook 'nroff-mode-hook))
+
+;;; Compute how much to indent a comment in nroff/troff source.
+;;; By mit-erl!gildea April 86
+(defun nroff-comment-indent ()
+  "Compute indent for an nroff/troff comment.
+Puts a full-stop before comments on a line by themselves."
+  (let ((pt (point)))
+    (unwind-protect
+	(progn
+	  (skip-chars-backward " \t")
+	  (if (bolp)
+	      (progn
+		(setq pt (1+ pt))
+		(insert ?.)
+		1)
+	    (if (save-excursion
+		  (backward-char 1)
+		  (looking-at "^[.']"))
+		1
+	      (max comment-column
+		   (* 8 (/ (+ (current-column)
+			      9) 8)))))) ; add 9 to ensure at least two blanks
+      (goto-char pt))))
+
+(defun count-text-lines (start end &optional print)
+  "Count lines in region, except for nroff request lines.
+All lines not starting with a period are counted up.
+Interactively, print result in echo area.
+Noninteractively, return number of non-request lines from START to END."
+  (interactive "r\np")
+  (if print
+      (message "Region has %d text lines" (count-text-lines start end))
+    (save-excursion
+      (save-restriction
+	(narrow-to-region start end)
+	(goto-char (point-min))
+	(- (buffer-size) (forward-text-line (buffer-size)))))))
+
+(defun forward-text-line (&optional cnt)
+  "Go forward one nroff text line, skipping lines of nroff requests.
+An argument is a repeat count; if negative, move backward."
+  (interactive "p")
+  (if (not cnt) (setq cnt 1))
+  (while (and (> cnt 0) (not (eobp)))
+    (forward-line 1)
+    (while (and (not (eobp)) (looking-at "[.']."))
+      (forward-line 1))
+    (setq cnt (- cnt 1)))
+  (while (and (< cnt 0) (not (bobp)))
+    (forward-line -1)
+    (while (and (not (bobp))
+		(looking-at "[.']."))
+      (forward-line -1))
+    (setq cnt (+ cnt 1)))
+  cnt)
+
+(defun backward-text-line (&optional cnt)
+  "Go backward one nroff text line, skipping lines of nroff requests.
+An argument is a repeat count; negative means move forward."
+  (interactive "p")
+  (forward-text-line (- cnt)))
+
+(defconst nroff-brace-table
+  '((".(b" . ".)b")
+    (".(l" . ".)l")
+    (".(q" . ".)q")
+    (".(c" . ".)c")
+    (".(x" . ".)x")
+    (".(z" . ".)z")
+    (".(d" . ".)d")
+    (".(f" . ".)f")
+    (".LG" . ".NL")
+    (".SM" . ".NL")
+    (".LD" . ".DE")
+    (".CD" . ".DE")
+    (".BD" . ".DE")
+    (".DS" . ".DE")
+    (".DF" . ".DE")
+    (".FS" . ".FE")
+    (".KS" . ".KE")
+    (".KF" . ".KE")
+    (".LB" . ".LE")
+    (".AL" . ".LE")
+    (".BL" . ".LE")
+    (".DL" . ".LE")
+    (".ML" . ".LE")
+    (".RL" . ".LE")
+    (".VL" . ".LE")
+    (".RS" . ".RE")
+    (".TS" . ".TE")
+    (".EQ" . ".EN")
+    (".PS" . ".PE")
+    (".BS" . ".BE")
+    (".G1" . ".G2")			; grap
+    (".na" . ".ad b")
+    (".nf" . ".fi")
+    (".de" . "..")))
+
+(defun electric-nroff-newline (arg)
+  "Insert newline for nroff mode; special if electric-nroff mode.
+In electric-nroff-mode, if ending a line containing an nroff opening request,
+automatically inserts the matching closing request after point."
+  (interactive "P")
+  (let ((completion (save-excursion
+		      (beginning-of-line)
+		      (and (null arg)
+			   nroff-electric-mode
+			   (<= (point) (- (point-max) 3))
+			   (cdr (assoc (buffer-substring (point)
+							 (+ 3 (point)))
+				       nroff-brace-table)))))
+	(needs-nl (not (looking-at "[ \t]*$"))))
+    (if (null completion)
+	(newline (prefix-numeric-value arg))
+      (save-excursion
+	(insert "\n\n" completion)
+	(if needs-nl (insert "\n")))
+      (forward-char 1))))
+
+(defun electric-nroff-mode (&optional arg)
+  "Toggle nroff-electric-newline minor mode
+Nroff-electric-newline forces emacs to check for an nroff
+request at the beginning of the line, and insert the
+matching closing request if necessary.  
+This command toggles that mode (off->on, on->off), 
+with an argument, turns it on iff arg is positive, otherwise off."
+  (interactive "P")
+  (or (eq major-mode 'nroff-mode) (error "Must be in nroff mode"))
+  (or (assq 'nroff-electric-mode minor-mode-alist)
+      (setq minor-mode-alist (append minor-mode-alist
+				     (list '(nroff-electric-mode
+					     " Electric")))))
+  (setq nroff-electric-mode
+	(cond ((null arg) (null nroff-electric-mode))
+	      (t (> (prefix-numeric-value arg) 0)))))
+
diff --git a/lisp/textmodes/page.el b/lisp/textmodes/page.el
new file mode 100644
index 0000000000..19b29d02f0
--- /dev/null
+++ b/lisp/textmodes/page.el
@@ -0,0 +1,123 @@
+;; Page motion commands for emacs.
+;; Copyright (C) 1985 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+(defun forward-page (&optional count)
+  "Move forward to page boundary.  With arg, repeat, or go back if negative.
+A page boundary is any line whose beginning matches the regexp  page-delimiter."
+  (interactive "p")
+  (or count (setq count 1))
+  (while (and (> count 0) (not (eobp)))
+    (if (re-search-forward page-delimiter nil t)
+	nil
+      (goto-char (point-max)))
+    (setq count (1- count)))
+  (while (and (< count 0) (not (bobp)))
+    (forward-char -1)
+    (if (re-search-backward page-delimiter nil t)
+	(goto-char (match-end 0))
+      (goto-char (point-min)))
+    (setq count (1+ count))))
+
+(defun backward-page (&optional count)
+  "Move backward to page boundary.  With arg, repeat, or go fwd if negative.
+A page boundary is any line whose beginning matches the regexp  page-delimiter."
+  (interactive "p")
+  (or count (setq count 1))
+  (forward-page (- count)))
+
+(defun mark-page (&optional arg)
+  "Put mark at end of page, point at beginning.
+A numeric arg specifies to move forward or backward by that many pages,
+thus marking a page other than the one point was originally in."
+  (interactive "P")
+  (setq arg (if arg (prefix-numeric-value arg) 0))
+  (if (> arg 0)
+      (forward-page arg)
+    (if (< arg 0)
+        (forward-page (1- arg))))
+  (forward-page)
+  (push-mark nil t)
+  (forward-page -1))
+
+(defun narrow-to-page (&optional arg)
+  "Make text outside current page invisible.
+A numeric arg specifies to move forward or backward by that many pages,
+thus showing a page other than the one point was originally in."
+  (interactive "P")
+  (setq arg (if arg (prefix-numeric-value arg) 0))
+  (save-excursion
+    (widen)
+    (if (> arg 0)
+	(forward-page arg)
+      (if (< arg 0)
+	  (forward-page (1- arg))))
+    ;; Find the end of the page.
+    (forward-page)
+    ;; If we stopped due to end of buffer, stay there.
+    ;; If we stopped after a page delimiter, put end of restriction
+    ;; at the beginning of that line.
+    (if (save-excursion (beginning-of-line)
+			(looking-at page-delimiter))
+	(beginning-of-line))
+    (narrow-to-region (point)
+		      (progn
+			;; Find the top of the page.
+			(forward-page -1)
+			;; If we found beginning of buffer, stay there.
+			;; If extra text follows page delimiter on same line,
+			;; include it.
+			;; Otherwise, show text starting with following line.
+			(if (and (eolp) (not (bobp)))
+			    (forward-line 1))
+			(point)))))
+
+(defun count-lines-page ()
+  "Report number of lines on current page, and how many are before or after point."
+  (interactive)
+  (save-excursion
+    (let ((opoint (point)) beg end
+	  total before after)
+      (forward-page)
+      (beginning-of-line)
+      (or (looking-at page-delimiter)
+	  (end-of-line))
+      (setq end (point))
+      (backward-page)
+      (setq beg (point))
+      (setq total (count-lines beg end)
+	    before (count-lines beg opoint)
+	    after (count-lines opoint end))
+      (message "Page has %d lines (%d + %d)" total before after))))
+
+(defun what-page ()
+  "Print page and line number of point."
+  (interactive)
+  (save-restriction
+    (widen)
+    (save-excursion
+      (beginning-of-line)
+      (let ((count 1)
+	    (opoint (point)))
+	(goto-char 1)
+	(while (re-search-forward page-delimiter opoint t)
+	  (setq count (1+ count)))
+	(message "Page %d, line %d"
+		 count
+		 (1+ (count-lines (point) opoint)))))))
diff --git a/lisp/textmodes/paragraphs.el b/lisp/textmodes/paragraphs.el
new file mode 100644
index 0000000000..c0bd7793a1
--- /dev/null
+++ b/lisp/textmodes/paragraphs.el
@@ -0,0 +1,205 @@
+;; Paragraph and sentence parsing.
+;; Copyright (C) 1985 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+(defvar paragraph-ignore-fill-prefix nil
+  "Non-nil means the paragraph commands are not affected by fill-prefix.
+This is desirable in modes where blank lines are the paragraph delimiters.")
+
+(defun forward-paragraph (&optional arg)
+  "Move forward to end of paragraph.
+With arg N, do it N times; negative arg -N means move forward N paragraphs.
+
+A line which `paragraph-start' matches either separates paragraphs
+\(if `paragraph-separate' matches it also) or is the first line of a paragraph.
+A paragraph end is the beginning of a line which is not part of the paragraph
+to which the end of the previous line belongs, or the end of the buffer."
+  (interactive "p")
+  (or arg (setq arg 1))
+  (let* ((fill-prefix-regexp
+	  (and fill-prefix (not (equal fill-prefix ""))
+	       (not paragraph-ignore-fill-prefix)
+	       (regexp-quote fill-prefix)))
+	 (paragraph-separate
+	  (if fill-prefix-regexp
+	      (concat paragraph-separate "\\|^"
+		      fill-prefix-regexp "[ \t]*$")
+	    paragraph-separate)))
+    (while (< arg 0)
+      (if (and (not (looking-at paragraph-separate))
+	       (re-search-backward "^\n" (max (1- (point)) (point-min)) t))
+	  nil
+	(forward-char -1) (beginning-of-line)
+	(while (and (not (bobp)) (looking-at paragraph-separate))
+	  (forward-line -1))
+	(end-of-line)
+	;; Search back for line that starts or separates paragraphs.
+	(if (if fill-prefix-regexp
+		;; There is a fill prefix; it overrides paragraph-start.
+		(progn
+		 (while (progn (beginning-of-line)
+			       (and (not (bobp))
+				    (not (looking-at paragraph-separate))
+				    (looking-at fill-prefix-regexp)))
+		   (forward-line -1))
+		 (not (bobp)))
+	      (re-search-backward paragraph-start nil t))
+	    ;; Found one.
+	    (progn
+	      (while (and (not (eobp)) (looking-at paragraph-separate))
+		(forward-line 1))
+	      (if (eq (char-after (- (point) 2)) ?\n)
+		  (forward-line -1)))
+	  ;; No starter or separator line => use buffer beg.
+	  (goto-char (point-min))))
+      (setq arg (1+ arg)))
+    (while (> arg 0)
+      (beginning-of-line)
+      (while (prog1 (and (not (eobp))
+			 (looking-at paragraph-separate))
+		    (forward-line 1)))
+      (if fill-prefix-regexp
+	  ;; There is a fill prefix; it overrides paragraph-start.
+	  (while (and (not (eobp))
+		      (not (looking-at paragraph-separate))
+		      (looking-at fill-prefix-regexp))
+	    (forward-line 1))
+	(if (re-search-forward paragraph-start nil t)
+	    (goto-char (match-beginning 0))
+	  (goto-char (point-max))))
+      (setq arg (1- arg)))))
+
+(defun backward-paragraph (&optional arg)
+  "Move backward to start of paragraph.
+With arg N, do it N times; negative arg -N means move forward N paragraphs.
+
+A paragraph start is the beginning of a line which is a first-line-of-paragraph
+or which is ordinary text and follows a paragraph-separating line; except:
+if the first real line of a paragraph is preceded by a blank line,
+the paragraph starts at that blank line.
+See forward-paragraph for more information."
+  (interactive "p")
+  (or arg (setq arg 1))
+  (forward-paragraph (- arg)))
+
+(defun mark-paragraph ()
+  "Put point at beginning of this paragraph, mark at end.
+The paragraph marked is the one that contains point or follows point."
+  (interactive)
+  (forward-paragraph 1)
+  (push-mark nil t)
+  (backward-paragraph 1))
+
+(defun kill-paragraph (arg)
+  "Kill forward to end of paragraph.
+With arg N, kill forward to Nth end of paragraph;
+negative arg -N means kill backward to Nth start of paragraph."
+  (interactive "*p")
+  (kill-region (point) (progn (forward-paragraph arg) (point))))
+
+(defun backward-kill-paragraph (arg)
+  "Kill back to start of paragraph.
+With arg N, kill back to Nth start of paragraph;
+negative arg -N means kill forward to Nth end of paragraph."
+  (interactive "*p")
+  (kill-region (point) (progn (backward-paragraph arg) (point))))
+
+(defun transpose-paragraphs (arg)
+  "Interchange this (or next) paragraph with previous one."
+  (interactive "*p")
+  (transpose-subr 'forward-paragraph arg))
+
+(defun start-of-paragraph-text ()
+  (let ((opoint (point)) npoint)
+    (forward-paragraph -1)
+    (setq npoint (point))
+    (skip-chars-forward " \t\n")
+    (if (>= (point) opoint)
+	(progn
+	  (goto-char npoint)
+	  (if (> npoint (point-min))
+	      (start-of-paragraph-text))))))
+
+(defun end-of-paragraph-text ()
+  (let ((opoint (point)))
+    (forward-paragraph 1)
+    (if (eq (preceding-char) ?\n) (forward-char -1))
+    (if (<= (point) opoint)
+	(progn
+	  (forward-char 1)
+	  (if (< (point) (point-max))
+	      (end-of-paragraph-text))))))
+
+(defun forward-sentence (&optional arg)
+  "Move forward to next sentence-end.  With argument, repeat.
+With negative argument, move backward repeatedly to sentence-beginning.
+
+The variable `sentence-end' is a regular expression that matches ends
+of sentences.  Also, every paragraph boundary terminates sentences as
+well."
+  (interactive "p")
+  (or arg (setq arg 1))
+  (while (< arg 0)
+    (let ((par-beg (save-excursion (start-of-paragraph-text) (point))))
+      (if (re-search-backward (concat sentence-end "[^ \t\n]") par-beg t)
+	  (goto-char (1- (match-end 0)))
+	(goto-char par-beg)))
+    (setq arg (1+ arg)))
+  (while (> arg 0)
+    (let ((par-end (save-excursion (end-of-paragraph-text) (point))))
+      (if (re-search-forward sentence-end par-end t)
+	  (skip-chars-backward " \t\n")
+	(goto-char par-end)))
+    (setq arg (1- arg))))
+
+(defun backward-sentence (&optional arg)
+  "Move backward to start of sentence.  With arg, do it arg times.
+See forward-sentence for more information."
+  (interactive "p")
+  (or arg (setq arg 1))
+  (forward-sentence (- arg)))
+
+(defun kill-sentence (&optional arg)
+  "Kill from point to end of sentence.
+With arg, repeat; negative arg -N means kill back to Nth start of sentence."
+  (interactive "*p")
+  (let ((beg (point)))
+    (forward-sentence arg)
+    (kill-region beg (point))))
+
+(defun backward-kill-sentence (&optional arg)
+  "Kill back from point to start of sentence.
+With arg, repeat, or kill forward to Nth end of sentence if negative arg -N."
+  (interactive "*p")
+  (let ((beg (point)))
+    (backward-sentence arg)
+    (kill-region beg (point))))
+
+(defun mark-end-of-sentence (arg)
+  "Put mark at end of sentence.  Arg works as in forward-sentence."
+  (interactive "p")
+  (push-mark
+    (save-excursion
+      (forward-sentence arg)
+      (point))))
+
+(defun transpose-sentences (arg)
+  "Interchange this (next) and previous sentence."
+  (interactive "*p")
+  (transpose-subr 'forward-sentence arg))
diff --git a/lisp/textmodes/refbib.el b/lisp/textmodes/refbib.el
new file mode 100644
index 0000000000..3b376cdd90
--- /dev/null
+++ b/lisp/textmodes/refbib.el
@@ -0,0 +1,715 @@
+;; Convert refer-style bibliographic entries to ones usable by latex bib
+;; Copyright (C) 1989 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;; Use: from a buffer containing the refer-style bibliography,
+;;   M-x r2b-convert-buffer
+;; Program will prompt for an output buffer name, and will log
+;; warnings during the conversion process in the buffer *Log*.
+
+; HISTORY
+; 9/88, created
+; modified 1/19/89, allow books with editor but no author;
+;                   added %O ordering field;
+;                   appended illegal multiple fields, instead of 
+;                     discarding;
+;                   added rule, a tech report whose %R number
+;                     contains "ISBN" is really a book
+;                   added rule, anything with an editor is a book
+;                     or a proceedings
+;                   added 'manual type, for items with institution
+;                     but no author or editor
+;                   fixed bug so trailing blanks are trimmed
+;                   added 'proceedings type
+;                   used "organization" field for proceedings
+; modified 2/16/89, updated help messages
+; modified 2/23/89, include capitalize stop words in r2b stop words,
+;                   fixed problems with contractions (e.g. it's),
+;                   caught multiple stop words in a row
+; modified 3/1/89,  fixed capitialize-title for first words all caps
+; modified 3/15/89, allow use of " to delimit fields
+; modified 4/18/89, properly "quote" special characters on output
+(provide 'refer-to-bibtex)
+;**********************************************************
+; User Parameters
+
+(defvar r2b-trace-on nil "*trace conversion")
+
+(defvar r2b-journal-abbrevs
+   '(  
+       )
+   "  Abbreviation list for journal names.  
+If the car of an element matches a journal name exactly, it is replaced by
+the cadr when output.  Braces must be included if replacement is a
+{string}, but not if replacement is a bibtex abbreviation.  The cadr
+may be eliminated if is exactly the same as the car.  
+  Because titles are capitalized before matching, the abbreviation
+for the journal name should be listed as beginning with a capital 
+letter, even if it really doesn't.
+  For example, a value of '((\"Aij\" \"{Artificial Intelligence}\")
+(\"Ijcai81\" \"ijcai7\")) would expand Aij to the text string
+\"Artificial Intelligence\", but would replace Ijcai81 with the 
+BibTeX macro \"ijcai7\".")
+
+(defvar r2b-booktitle-abbrevs 
+   '(  
+       )
+   "  Abbreviation list for book and proceedings names.  If the car of
+an element matches a title or booktitle exactly, it is replaced by 
+the cadr when output.  Braces must be included if replacement is 
+a {string}, but not if replacement is a bibtex abbreviation.  The cadr 
+may be eliminated if is exactly the same as the car.  
+  Because titles are capitalized before matching, the abbreviated title
+should be listed as beginning with a capital letter, even if it doesn't.
+  For example, a value of '((\"Aij\" \"{Artificial Intelligence}\")
+(\"Ijcai81\" \"ijcai7\")) would expand Aij to the text string
+\"Artificial Intelligence\", but would replace Ijcai81 with the 
+BibTeX macro \"ijcai7\".")
+
+(defvar r2b-proceedings-list
+   '()
+   "  Assoc list of books or journals which are really conference proceedings,
+but whose name and whose abbrev expansion (as defined in r2b-journal-abbrevs
+and r2b-booktitle-abbrevs) does not contain the words 'conference' or
+'proceedings'.  (Those cases are handled automatically.)
+The entry must match the given data exactly.
+  Because titles are capitalized before matching, the items in this list 
+should begin with a capital letter.
+  For example, suppose the title \"Ijcai81\" is used for the proceedings of
+a conference, and it's expansion is the BibTeX macro \"ijcai7\".  Then 
+r2b-proceedings-list should be '((\"Ijcai81\") ...).  If instead its 
+expansion were \"Proceedings of the Seventh International Conference
+on Artificial Intelligence\", then you would NOT need to include Ijcai81 
+in r2b-proceedings-list (although it wouldn't cause an error).")
+
+(defvar r2b-additional-stop-words
+	 "Some\\|What"
+   "Words other than the capitialize-title-stop-words
+which are not to be used to build the citation key")
+
+
+(defvar r2b-delimit-with-quote
+  t
+  "*If true, then use \" to delimit fields, otherwise use braces")
+
+;**********************************************************
+; Utility Functions
+
+(defvar capitalize-title-stop-words
+   (concat
+      "the\\|and\\|of\\|is\\|a\\|an\\|of\\|for\\|in\\|to\\|in\\|on\\|at\\|"
+      "by\\|with\\|that\\|its")
+   "Words not to be capitialized in a title (unless they are the first
+word in the title)")
+
+(defvar capitalize-title-stop-regexp
+   (concat "\\(" capitalize-title-stop-words "\\)\\(\\b\\|'\\)"))
+
+(defun capitalize-title-region (begin end)
+   "Like capitalize-region, but don't capitalize stop words, except the first"
+   (interactive "r")
+   (let ((case-fold-search nil) (orig-syntax-table (syntax-table)))
+      (unwind-protect
+	 (save-restriction
+	    (set-syntax-table text-mode-syntax-table)
+	    (narrow-to-region begin end)
+	    (goto-char (point-min))
+	    (if (looking-at "[A-Z][a-z]*[A-Z]")
+	       (forward-word 1)
+	       (capitalize-word 1))
+	    (while (re-search-forward "\\<" nil t)
+	       (if (looking-at "[A-Z][a-z]*[A-Z]")
+		  (forward-word 1)
+		  (if (let ((case-fold-search t))
+			 (looking-at capitalize-title-stop-regexp))
+		     (downcase-word 1)
+		     (capitalize-word 1)))
+	       ))
+	 (set-syntax-table orig-syntax-table))))
+
+
+(defun capitalize-title (s)
+   "Like capitalize, but don't capitalize stop words, except the first"
+   (save-excursion
+      (set-buffer (get-buffer-create "$$$Scratch$$$"))
+      (erase-buffer)
+      (insert s)
+      (capitalize-title-region (point-min) (point-max))
+      (buffer-string)))
+
+;*********************************************************
+(defun r2b-reset ()
+   "unbind defvars, for debugging"
+   (interactive)
+   (makunbound 'r2b-journal-abbrevs)
+   (makunbound 'r2b-booktitle-abbrevs)
+   (makunbound 'r2b-proceedings-list)
+   (makunbound 'capitalize-title-stop-words)
+   (makunbound 'capitalize-title-stop-regexp)
+   (makunbound 'r2b-additional-stop-words)
+   (makunbound 'r2b-stop-regexp)
+   )
+
+(defvar r2b-stop-regexp
+   (concat "\\`\\(\\(" 
+      r2b-additional-stop-words "\\|" capitalize-title-stop-words
+      "\\)\\('\\w*\\)?\\W+\\)*\\([A-Z0-9]+\\)"))
+
+
+(defun r2b-trace (&rest args)
+   (if r2b-trace-on
+      (progn
+	 (apply (function message) args)
+	 (sit-for 0)
+	 )))
+
+(defun r2b-match (exp)
+   "returns string matched in current buffer"
+   (buffer-substring (match-beginning exp) (match-end exp)))
+
+(defvar r2b-out-buf-name "*Out*" "*output from refer-to-bibtex" )
+(defvar r2b-log-name "*Log*" "*logs errors from refer-to-bibtex" )
+(defvar r2b-in-buf nil)
+(defvar r2b-out-buf nil)
+(defvar r2b-log nil)
+
+(defvar r2b-error-found nil)
+
+(setq r2b-variables '(
+			r2b-error-found
+			  r2bv-author
+			  r2bv-primary-author
+			  r2bv-date
+			  r2bv-year
+			  r2bv-decade
+			  r2bv-month
+			  r2bv-title
+			  r2bv-title-first-word
+			  r2bv-editor
+			  r2bv-annote
+			  r2bv-tr
+			  r2bv-address
+			  r2bv-institution
+			  r2bv-keywords
+			  r2bv-booktitle
+			  r2bv-journal
+			  r2bv-volume
+			  r2bv-number
+			  r2bv-pages
+			  r2bv-booktitle
+			  r2bv-kn
+			  r2bv-publisher
+			  r2bv-organization
+			  r2bv-school
+			  r2bv-type
+			  r2bv-where
+			  r2bv-note
+			  r2bv-ordering
+			  ))
+
+(defun r2b-clear-variables ()
+   "set all global vars used by r2b to nil"
+   (let ((vars r2b-variables))
+      (while vars
+	 (set (car vars) nil)
+	 (setq vars (cdr vars)))
+      ))
+
+(defun r2b-warning (&rest args)
+   (setq r2b-error-found t)
+   (princ (apply (function format) args) r2b-log)
+   (princ "\n" r2b-log)
+   (princ "\n" r2b-out-buf)
+   (princ "% " r2b-out-buf)
+   (princ (apply (function format) args) r2b-out-buf)
+   )
+
+(defun r2b-get-field (var field &optional unique required capitalize)
+   "Set VAR to string value of FIELD, if any.  If none, VAR is set to
+nil.  If multiple fields appear, then separate values with the
+'\\nand\\t\\t', unless UNIQUE is non-nil, in which case log a warning
+and just concatenate the values.  Trim off leading blanks and tabs on
+first line, and trailing blanks and tabs of every line.  Log a warning
+and set VAR to the empty string if REQUIRED is true.  Capitalize as a
+title if CAPITALIZE is true.  Returns value of VAR."
+   (let (item val (not-past-end t))
+      (r2b-trace "snarfing %s" field)
+      (goto-char (point-min))
+      (while (and not-past-end
+		(re-search-forward 
+		   (concat "^" field "\\b[ \t]*\\(.*[^ \t\n]\\)[ \t]*") nil t))
+	 (setq item (r2b-match 1))
+	 (while (and (setq not-past-end (zerop (forward-line 1)))
+		   (not (looking-at "[ \t]*$\\|%")))
+	       (looking-at "\\(.*[^ \t\n]\\)[ \t]*$")
+	       (setq item (concat item "\n" (r2b-match 1)))
+	    )
+	 (if (null val)
+	    (setq val item)
+	    (if unique
+	       (progn
+		  (r2b-warning "*Illegal multiple field %s %s" field item)
+		  (setq val (concat val "\n" item))
+		  )
+	       (setq val (concat val "\n\t\tand " item))
+	       )
+	    )
+	 )
+      (if (and val capitalize)
+	 (setq val (capitalize-title val)))
+      (set var val)
+      (if (and (null val) required)
+	 (r2b-require var))
+      ))
+
+(defun r2b-set-match (var n regexp string )
+   "set VAR to the Nth subpattern in REGEXP matched by STRING, or nil if none"
+   (set var
+      (if (and (stringp string) (string-match regexp string))
+	 (substring string (match-beginning n) (match-end n))
+	 nil)
+      )
+   )
+
+(defvar r2b-month-abbrevs
+   '(("jan") ("feb") ("mar") ("apr") ("may") ("jun") ("jul") ("aug")
+       ("sep") ("oct") ("nov") ("dec")))
+
+(defun r2b-convert-month ()
+   "Try to convert r2bv-month to a standard 3 letter name"
+   (if r2bv-month
+      (let ((months r2b-month-abbrevs))
+	 (if (string-match "[^0-9]" r2bv-month)
+	    (progn
+	       (while (and months (not (string-match (car (car months)) 
+					  r2bv-month)))
+		  (setq months (cdr months)))
+	       (if months
+		  (setq r2bv-month (car (car months)))))
+	    (progn
+	       (setq months (car (read-from-string r2bv-month)))
+	       (if (and (numberp months)
+		      (> months 0)
+		      (< months 13))
+		  (setq r2bv-month (car (nth months r2b-month-abbrevs)))
+		  (progn
+		     (r2b-warning "* Ridiculous month")
+		     (setq r2bv-month nil))
+		  ))
+	    ))
+      )
+   )
+
+(defun r2b-snarf-input ()
+   "parse buffer into global variables"
+   (let ((case-fold-search t))
+      (r2b-trace "snarfing...")
+      (sit-for 0)
+      (set-buffer r2b-in-buf)
+      (goto-char (point-min))
+      (princ "    " r2b-log)
+      (princ (buffer-substring (point) (progn (end-of-line) (point))) r2b-log)
+      (terpri r2b-log)
+
+      (r2b-get-field 'r2bv-author "%A")
+      (r2b-get-field 'r2bv-editor "%E")
+      (cond
+	 (r2bv-author
+	    (r2b-set-match 'r2bv-primary-author 1
+	       "\\b\\(\\w+\\)[ \t]*\\($\\|,\\)" r2bv-author)
+	    )
+	 (r2bv-editor
+	    (r2b-set-match 'r2bv-primary-author 1
+	       "\\b\\(\\w+\\)[ \t]*\\($\\|,\\)" r2bv-editor)
+	    )
+	 (t
+	    (setq r2bv-primary-author "")
+	    )
+	 )
+
+      (r2b-get-field 'r2bv-date "%D" t t)
+      (r2b-set-match 'r2bv-year 0 "[12][0-9][0-9][0-9]" r2bv-date)
+      (and (null r2bv-year)
+	 (r2b-set-match 'r2bv-year 1 "[^0-9]\\([0-9][0-9]\\)$" r2bv-date)
+	 (setq r2bv-year (concat "19" r2bv-year)))
+      (r2b-set-match 'r2bv-decade 1 "..\\(..\\)" r2bv-year)
+      (r2b-set-match 'r2bv-month 0
+	 "[0-9]+/\\|[a-zA-Z]+" r2bv-date)
+      (if (and (stringp r2bv-month) (string-match "\\(.*\\)/$" r2bv-month))
+	 (setq r2bv-month (substring r2bv-month 0 (match-end 1))))
+      (r2b-convert-month)
+
+      (r2b-get-field 'r2bv-title "%T" t t t)
+      (r2b-set-match 'r2bv-title-first-word 4
+	 r2b-stop-regexp
+	 r2bv-title)
+      
+      (r2b-get-field 'r2bv-annote "%X" t )
+      (r2b-get-field 'r2bv-tr "%R" t)
+      (r2b-get-field 'r2bv-address "%C" t)
+      (r2b-get-field 'r2bv-institution "%I" t)
+      (r2b-get-field 'r2bv-keywords "%K")
+      (r2b-get-field 'r2bv-booktitle "%B" t nil t)
+      (r2b-get-field 'r2bv-journal "%J" t nil t)
+      (r2b-get-field 'r2bv-volume "%V" t)
+      (r2b-get-field 'r2bv-number "%N" t)
+      (r2b-get-field 'r2bv-pages "%P" t)
+      (r2b-get-field 'r2bv-where "%W" t)
+      (r2b-get-field 'r2bv-ordering "%O" t)
+      )
+   )
+
+
+(defun r2b-put-field (field data &optional abbrevs)
+  "print bibtex FIELD = {DATA} if DATA not null; precede
+with a comma and newline; if ABBREVS list is given, then
+try to replace the {DATA} with an abbreviation"
+  (if data
+    (let (match nodelim multi-line index)
+      (cond
+	((and abbrevs (setq match (assoc data abbrevs)))
+	  (if (null (cdr match))
+	    (setq data (car match))
+	    (setq data (car (cdr match))))
+	  (setq nodelim t))
+	((and (not (equal data ""))
+		(not (string-match "[^0-9]" data)))
+	  (setq nodelim t))
+	(t
+	  (setq index 0)
+	  (while (string-match "[\\~^]" data index)
+	    (setq data (concat (substring data 0 (match-beginning 0))
+			 "\\verb+"
+			 (substring data (match-beginning 0) (match-end 0))
+			 "+"
+			 (substring data (match-end 0))))
+	    (setq index (+ (match-end 0) 7)))
+	  (setq index 0)
+	  (while (string-match "[$&%#_{}]" data index)
+	    (setq data (concat (substring data 0 (match-beginning 0))
+			 "\\"
+			 (substring data (match-beginning 0))))
+	    (setq index (+ (match-end 0) 1)))
+	  (setq index 0)
+	  (if r2b-delimit-with-quote
+	    (while (string-match "\"" data index)
+	      (setq data (concat (substring data 0 (match-beginning 0))
+			   "{\"}"
+			   (substring data (match-end 0))))
+	      (setq index (+ (match-end 0) 2))))
+	    ))
+      (princ ", \n  ")
+      (princ field)
+      (princ " =\t")
+      (if (not nodelim) 
+	(if r2b-delimit-with-quote
+	  (princ "\"")
+	  (princ "{")))
+      (string-match ".*" data)
+      (if (> (match-end 0) 59)
+	(princ "\n"))
+      (princ data)
+      (if (not nodelim) 
+	(if r2b-delimit-with-quote
+	  (princ "\"")
+	  (princ "}")))
+      )
+    ))
+
+
+(defun r2b-require (vars)
+   "If any of VARS is null, set to empty string and log error"
+   (cond 
+      ((null vars))
+      ((listp vars) (r2b-require (car vars)) (r2b-require (cdr vars)))
+      (t
+	 (if (null (symbol-value vars))
+	    (progn
+	       (r2b-warning "*Missing value for field %s" vars)
+	       (set vars "")
+	       )))
+      )
+   )
+
+
+(defmacro r2b-moveq (new old)
+   "set NEW to OLD and set OLD to nil"
+   (list 'progn (list 'setq new old) (list 'setq old 'nil)))
+
+(defun r2b-isa-proceedings (name)
+   "return t if NAME is the name of proceedings"
+   (and
+      name
+      (or
+	 (string-match "proceedings\\|conference" name)
+	 (assoc name r2b-proceedings-list)
+	 (let ((match (assoc name r2b-booktitle-abbrevs)))
+	    (and match
+	       (string-match "proceedings\\|conference" (car (cdr match)))))
+      )))
+
+(defun r2b-isa-university (name)
+   "return t if NAME is a university or similar organization, 
+but not a publisher"
+   (and 
+      name
+      (string-match "university" name)
+      (not (string-match "press" name))
+
+   ))
+
+(defun r2b-barf-output ()
+   "generate bibtex based on global variables"
+   (let ((standard-output r2b-out-buf) (case-fold-search t) match)
+
+      (r2b-trace "...barfing")
+      (sit-for 0)
+      (set-buffer r2b-out-buf)
+
+      (setq r2bv-kn (concat r2bv-primary-author r2bv-decade
+			r2bv-title-first-word))
+      
+      (setq r2bv-entry-kind
+	 (cond 
+	    ((r2b-isa-proceedings r2bv-journal)
+	       (r2b-moveq r2bv-booktitle r2bv-journal)
+	       (if (r2b-isa-university r2bv-institution)
+		  (r2b-moveq r2bv-organization r2bv-institution)
+		  (r2b-moveq r2bv-publisher r2bv-institution))
+	       (r2b-moveq r2bv-note r2bv-tr)
+	       (r2b-require 'r2bv-author)
+	       'inproceedings)
+	    ((r2b-isa-proceedings r2bv-booktitle)
+	       (if (r2b-isa-university r2bv-institution)
+		  (r2b-moveq r2bv-organization r2bv-institution)
+		  (r2b-moveq r2bv-publisher r2bv-institution))
+	       (r2b-moveq r2bv-note r2bv-tr)
+	       (r2b-require 'r2bv-author)
+	       'inproceedings)
+	    ((and r2bv-tr (string-match "phd" r2bv-tr))
+	       (r2b-moveq r2bv-school r2bv-institution)
+	       (r2b-require 'r2bv-school )
+	       (r2b-require 'r2bv-author)
+	       'phdthesis)
+	    ((and r2bv-tr (string-match "master" r2bv-tr))
+	       (r2b-moveq r2bv-school r2bv-institution)
+	       (r2b-require 'r2bv-school )
+	       (r2b-require 'r2bv-author)
+	       'mastersthesis)
+	    ((and r2bv-tr (string-match "draft\\|unpublish" r2bv-tr))
+	       (r2b-moveq r2bv-note r2bv-institution)
+	       (r2b-require 'r2bv-author)
+	       'unpublished)
+	    (r2bv-journal
+	       (r2b-require 'r2bv-author)
+	       'article)
+	    (r2bv-booktitle
+	       (r2b-moveq r2bv-publisher r2bv-institution)
+	       (r2b-moveq r2bv-note r2bv-tr)
+	       (r2b-require 'r2bv-publisher)
+	       (r2b-require 'r2bv-author)
+	       'incollection)
+	    ((and r2bv-author
+		(null r2bv-editor)
+		(string-match "\\`personal communication\\'" r2bv-title))
+	       'misc)
+	    ((r2b-isa-proceedings r2bv-title)
+	       (if (r2b-isa-university r2bv-institution)
+		  (r2b-moveq r2bv-organization r2bv-institution)
+		  (r2b-moveq r2bv-publisher r2bv-institution))
+	       (r2b-moveq r2bv-note r2bv-tr)
+	       'proceedings)
+	    ((or r2bv-editor
+		(and r2bv-author
+		   (or 
+		      (null r2bv-tr)
+		      (string-match "\\bisbn\\b" r2bv-tr))))
+	       (r2b-moveq r2bv-publisher r2bv-institution)
+	       (r2b-moveq r2bv-note r2bv-tr)
+	       (r2b-require 'r2bv-publisher)
+	       (if (null r2bv-editor)
+		  (r2b-require 'r2bv-author))
+	       'book)
+	    (r2bv-tr
+	       (r2b-require 'r2bv-institution)
+	       (if (string-match 
+		      "\\`\\(\\(.\\|\n\\)+\\)[ \t\n]+\\([^ \t\n]\\)+\\'" 
+		      r2bv-tr)
+		  (progn
+		     (setq r2bv-type (substring r2bv-tr 0 (match-end 1)))
+		     (setq r2bv-number (substring r2bv-tr 
+					  (match-beginning 3)))
+		     (setq r2bv-tr nil))
+		  (r2b-moveq r2bv-number r2bv-tr))
+	       (r2b-require 'r2bv-author)
+	       'techreport)
+	    (r2bv-institution
+	       (r2b-moveq r2bv-organization r2bv-institution)
+	       'manual)
+	    (t
+	       'misc)
+	    ))
+
+      (r2b-require '( r2bv-year))
+
+      (if r2b-error-found
+	 (princ "\n% Warning -- Errors During Conversion Next Entry\n"))
+
+      (princ "\n@")
+      (princ r2bv-entry-kind)
+      (princ "( ")
+      (princ r2bv-kn)
+
+      (r2b-put-field "author" r2bv-author )
+      (r2b-put-field "title" r2bv-title r2b-booktitle-abbrevs)
+      (r2b-put-field "year" r2bv-year )
+
+      (r2b-put-field "month" r2bv-month r2b-month-abbrevs)
+      (r2b-put-field "journal" r2bv-journal r2b-journal-abbrevs)
+      (r2b-put-field "volume" r2bv-volume)
+      (r2b-put-field "type" r2bv-type)
+      (r2b-put-field "number" r2bv-number)
+      (r2b-put-field "booktitle" r2bv-booktitle r2b-booktitle-abbrevs)
+      (r2b-put-field "editor" r2bv-editor)
+      (r2b-put-field "publisher" r2bv-publisher)
+      (r2b-put-field "institution" r2bv-institution)
+      (r2b-put-field "organization" r2bv-organization)
+      (r2b-put-field "school" r2bv-school)
+      (r2b-put-field "pages" r2bv-pages)
+      (r2b-put-field "address" r2bv-address)
+      (r2b-put-field "note" r2bv-note)
+      (r2b-put-field "keywords" r2bv-keywords)
+      (r2b-put-field "where" r2bv-where)
+      (r2b-put-field "ordering" r2bv-ordering)
+      (r2b-put-field "annote" r2bv-annote)
+
+      (princ " )\n")
+      )
+   )
+
+
+(defun r2b-convert-record (output-name)
+   "transform current bib entry and append to buffer OUTPUT;
+do M-x r2b-help for more info"
+   (interactive 
+      (list (read-string "Output to buffer: " r2b-out-buf-name)))
+   (let (rec-end rec-begin not-done)
+      (setq r2b-out-buf-name output-name)
+      (setq r2b-out-buf (get-buffer-create output-name))
+      (setq r2b-in-buf (current-buffer))
+      (set-buffer r2b-out-buf)
+      (goto-char (point-max))
+      (setq r2b-log (get-buffer-create r2b-log-name))
+      (set-buffer r2b-log)
+      (goto-char (point-max))
+      (set-buffer r2b-in-buf)
+      (setq not-done (re-search-forward "[^ \t\n]" nil t))
+      (if not-done
+	 (progn
+	    (re-search-backward "^[ \t]*$" nil 2)
+	    (re-search-forward "^%")
+	    (beginning-of-line nil)
+	    (setq rec-begin (point))
+	    (re-search-forward "^[ \t]*$" nil 2)
+	    (setq rec-end (point))
+	    (narrow-to-region rec-begin rec-end)
+	    (r2b-clear-variables)
+	    (r2b-snarf-input)
+	    (r2b-barf-output)
+	    (set-buffer r2b-in-buf)
+	    (widen)
+	    (goto-char rec-end)
+	    t)
+	 nil
+	 )
+      ))
+      
+      
+(defun r2b-convert-buffer (output-name)
+   "transform current buffer and append to buffer OUTPUT;
+do M-x r2b-help for more info"
+   (interactive 
+      (list (read-string "Output to buffer: " r2b-out-buf-name)))
+   (save-excursion
+      (setq r2b-log (get-buffer-create r2b-log-name))
+      (set-buffer r2b-log)
+      (erase-buffer))
+   (widen)
+   (goto-char (point-min))
+   (message "Working, please be patient...")
+   (sit-for 0)
+   (while (r2b-convert-record output-name) t)
+   (message "Done, results in %s, errors in %s" 
+      r2b-out-buf-name r2b-log-name)
+   )
+
+(defvar r2b-load-quietly nil "*Don't print help message when loaded")
+
+(defvar r2b-help-message
+"                   Refer to Bibtex Bibliography Conversion
+
+A refer-style database is of the form:
+
+%A Joe Blow
+%T Great Thoughts I've Thought
+%D 1977
+etc.
+
+This utility converts these kind of databases to bibtex form, for
+users of TeX and LaTex.  Instructions:
+1.  Visit the file containing the refer-style database.
+2.  The command
+	M-x r2b-convert-buffer
+    converts the entire buffer, appending it's output by default in a
+    buffer named *Out*, and logging progress and errors in a buffer
+    named *Log*.  The original file is never modified.
+	Note that results are appended to *Out*, so if that buffer
+	buffer already exists and contains material you don't want to
+ 	save, you should kill it first.
+3.  Switch to the buffer *Out* and save it as a named file.
+4.  To convert a single refer-style entry, simply position the cursor
+    at the entry and enter
+	M-x r2b-convert-record
+    Again output is appended to *Out* and errors are logged in *Log*.
+
+This utility is very robust and pretty smart about determining the
+type of the entry.  It includes facilities for expanding refer macros
+to text, or substituting bibtex macros.  Do M-x describe-variable on
+     r2b-journal-abbrevs
+     r2b-booktitle-abbrevs
+     r2b-proceedings-list
+for information on these features.
+
+If you don't want to see this help message when you load this utility,
+then include the following line in your .emacs file:
+	(setq r2b-load-quietly t)
+To see this message again, perform 
+         M-x r2b-help")
+
+
+(defun r2b-help ()
+   "print help message"
+   (interactive)
+   (with-output-to-temp-buffer "*Help*"
+      (princ r2b-help-message)))
+
+(if (not r2b-load-quietly)
+   (r2b-help))
+
+(message "r2b loaded")
+
diff --git a/lisp/textmodes/spell.el b/lisp/textmodes/spell.el
new file mode 100644
index 0000000000..d7cd286141
--- /dev/null
+++ b/lisp/textmodes/spell.el
@@ -0,0 +1,132 @@
+;; Spelling correction interface for Emacs.
+;; Copyright (C) 1985 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+(defvar spell-command "spell"
+  "*Command to run the spell program.")
+
+(defvar spell-filter nil
+  "*Filter function to process text before passing it to spell program.
+This function might remove text-processor commands.
+nil means don't alter the text before checking it.")
+
+(defun spell-buffer ()
+  "Check spelling of every word in the buffer.
+For each incorrect word, you are asked for the correct spelling
+and then put into a query-replace to fix some or all occurrences.
+If you do not want to change a word, just give the same word
+as its \"correct\" spelling; then the query replace is skipped."
+  (interactive)
+  (spell-region (point-min) (point-max) "buffer"))
+
+(defun spell-word ()
+  "Check spelling of word at or before point.
+If it is not correct, ask user for the correct spelling
+and query-replace the entire buffer to substitute it."
+  (interactive)
+  (let (beg end spell-filter)
+    (save-excursion
+     (if (not (looking-at "\\<"))
+	 (forward-word -1))
+     (setq beg (point))
+     (forward-word 1)
+     (setq end (point)))
+    (spell-region beg end (buffer-substring beg end))))
+
+(defun spell-region (start end &optional description)
+  "Like spell-buffer but applies only to region.
+Used in a program, applies from START to END.
+DESCRIPTION is an optional string naming the unit being checked:
+for example, \"word\"."
+  (interactive "r")
+  (let ((filter spell-filter)
+	(buf (get-buffer-create " *temp*")))
+    (save-excursion
+     (set-buffer buf)
+     (widen)
+     (erase-buffer))
+    (message "Checking spelling of %s..." (or description "region"))
+    (if (and (null filter) (= ?\n (char-after (1- end))))
+	(if (string= "spell" spell-command)
+	    (call-process-region start end "spell" nil buf)
+	  (call-process-region start end shell-file-name
+			       nil buf nil "-c" spell-command))
+      (let ((oldbuf (current-buffer)))
+	(save-excursion
+	 (set-buffer buf)
+	 (insert-buffer-substring oldbuf start end)
+	 (or (bolp) (insert ?\n))
+	 (if filter (funcall filter))
+	 (if (string= "spell" spell-command)
+	     (call-process-region (point-min) (point-max) "spell" t buf)
+	   (call-process-region (point-min) (point-max) shell-file-name
+				t buf nil "-c" spell-command)))))
+    (message "Checking spelling of %s...%s"
+	     (or description "region")
+	     (if (save-excursion
+		  (set-buffer buf)
+		  (> (buffer-size) 0))
+		 "not correct"
+	       "correct"))
+    (let (word newword
+	  (case-fold-search t)
+	  (case-replace t))
+      (while (save-excursion
+	      (set-buffer buf)
+	      (> (buffer-size) 0))
+	(save-excursion
+	 (set-buffer buf)
+	 (goto-char (point-min))
+	 (setq word (downcase
+		     (buffer-substring (point)
+				       (progn (end-of-line) (point)))))
+	 (forward-char 1)
+	 (delete-region (point-min) (point))
+	 (setq newword
+	       (read-input (concat "`" word
+				   "' not recognized; edit a replacement: ")
+			   word))
+	 (flush-lines (concat "^" (regexp-quote word) "$")))
+	(if (not (equal word newword))
+	    (progn
+	     (goto-char (point-min))
+	     (query-replace-regexp (concat "\\b" (regexp-quote word) "\\b")
+				   newword)))))))
+
+
+(defun spell-string (string)
+  "Check spelling of string supplied as argument."
+  (interactive "sSpell string: ")
+  (let ((buf (get-buffer-create " *temp*")))
+    (save-excursion
+     (set-buffer buf)
+     (widen)
+     (erase-buffer)
+     (insert string "\n")
+     (if (string= "spell" spell-command)
+	 (call-process-region (point-min) (point-max) "spell"
+			      t t)
+       (call-process-region (point-min) (point-max) shell-file-name
+			    t t nil "-c" spell-command))
+     (if (= 0 (buffer-size))
+	 (message "%s is correct" string)
+       (goto-char (point-min))
+       (while (search-forward "\n" nil t)
+	 (replace-match " "))
+       (message "%sincorrect" (buffer-substring 1 (point-max)))))))
diff --git a/lisp/textmodes/text-mode.el b/lisp/textmodes/text-mode.el
new file mode 100644
index 0000000000..ba54cb845f
--- /dev/null
+++ b/lisp/textmodes/text-mode.el
@@ -0,0 +1,147 @@
+;; Text mode, and its ideosyncratic commands.
+;; Copyright (C) 1985 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+(defvar text-mode-syntax-table nil
+  "Syntax table used while in text mode.")
+
+(defvar text-mode-abbrev-table nil
+  "Abbrev table used while in text mode.")
+(define-abbrev-table 'text-mode-abbrev-table ())
+
+(if text-mode-syntax-table
+    ()
+  (setq text-mode-syntax-table (make-syntax-table))
+  (modify-syntax-entry ?\" ".   " text-mode-syntax-table)
+  (modify-syntax-entry ?\\ ".   " text-mode-syntax-table)
+  (modify-syntax-entry ?' "w   " text-mode-syntax-table))
+
+(defvar text-mode-map nil
+  "Keymap for Text mode.
+Many other modes, such as Mail mode, Outline mode and Indented Text mode,
+inherit all the commands defined in this map.")
+
+(if text-mode-map
+    ()
+  (setq text-mode-map (make-sparse-keymap))
+  (define-key text-mode-map "\t" 'tab-to-tab-stop)
+  (define-key text-mode-map "\es" 'center-line)
+  (define-key text-mode-map "\eS" 'center-paragraph))
+
+
+;(defun non-saved-text-mode ()
+;  "Like text-mode, but delete auto save file when file is saved for real."
+;  (text-mode)
+;  (make-local-variable 'delete-auto-save-files)
+;  (setq delete-auto-save-files t))
+
+(defun text-mode ()
+  "Major mode for editing text intended for humans to read.  Special commands:\\{text-mode-map}
+Turning on text-mode calls the value of the variable `text-mode-hook',
+if that value is non-nil."
+  (interactive)
+  (kill-all-local-variables)
+  (use-local-map text-mode-map)
+  (setq mode-name "Text")
+  (setq major-mode 'text-mode)
+  (setq local-abbrev-table text-mode-abbrev-table)
+  (set-syntax-table text-mode-syntax-table)
+  (run-hooks 'text-mode-hook))
+
+(defvar indented-text-mode-map ()
+  "Keymap for Indented Text mode.
+All the commands defined in Text mode are inherited unless overridden.")
+
+(if indented-text-mode-map
+    ()
+  (setq indented-text-mode-map (nconc (make-sparse-keymap) text-mode-map))
+  (define-key indented-text-mode-map "\t" 'indent-relative))
+
+(defun indented-text-mode ()
+  "Major mode for editing indented text intended for humans to read.\\{indented-text-mode-map}
+Turning on indented-text-mode calls the value of the variable `text-mode-hook',
+if that value is non-nil."
+  (interactive)
+  (kill-all-local-variables)
+  (use-local-map text-mode-map)
+  (define-abbrev-table 'text-mode-abbrev-table ())
+  (setq local-abbrev-table text-mode-abbrev-table)
+  (set-syntax-table text-mode-syntax-table)
+  (make-local-variable 'indent-line-function)
+  (setq indent-line-function 'indent-relative-maybe)
+  (use-local-map indented-text-mode-map)
+  (setq mode-name "Indented Text")
+  (setq major-mode 'indented-text-mode)
+  (run-hooks 'text-mode-hook))
+
+(defun change-log-mode ()
+  "Major mode for editing ChangeLog files.  See M-x add-change-log-entry.
+Almost the same as Indented Text mode, but prevents numeric backups
+and sets `left-margin' to 8 and `fill-column' to 74."
+  (interactive)
+  (indented-text-mode)
+  (setq left-margin 8)
+  (setq fill-column 74)
+  (make-local-variable 'version-control)
+  (setq version-control 'never)
+  (run-hooks 'change-log-mode-hook))
+
+(defun center-paragraph ()
+  "Center each nonblank line in the paragraph at or after point.
+See center-line for more info."
+  (interactive)
+  (save-excursion
+    (forward-paragraph)
+    (or (bolp) (newline 1))
+    (let ((end (point)))
+      (backward-paragraph)
+      (center-region (point) end))))
+
+(defun center-region (from to)
+  "Center each nonblank line starting in the region.
+See center-line for more info."
+  (interactive "r")
+  (if (> from to)
+      (let ((tem to))
+	(setq to from from tem)))
+  (save-excursion
+    (save-restriction
+      (narrow-to-region from to)
+      (goto-char from)
+      (while (not (eobp))
+	(or (save-excursion (skip-chars-forward " \t") (eolp))
+	    (center-line))
+	(forward-line 1)))))
+
+(defun center-line ()
+  "Center the line point is on, within the width specified by `fill-column'.
+This means adjusting the indentation so that it equals
+the distance between the end of the text and `fill-column'."
+  (interactive)
+  (save-excursion
+    (let (line-length)
+      (beginning-of-line)
+      (delete-horizontal-space)
+      (end-of-line)
+      (delete-horizontal-space)
+      (setq line-length (current-column))
+      (beginning-of-line)
+      (indent-to 
+	(+ left-margin 
+	   (/ (- fill-column left-margin line-length) 2))))))
diff --git a/lisp/textmodes/underline.el b/lisp/textmodes/underline.el
new file mode 100644
index 0000000000..4a9f3dfa82
--- /dev/null
+++ b/lisp/textmodes/underline.el
@@ -0,0 +1,46 @@
+;; Insert or remove underlining (done by overstriking) in Emacs.
+;; Copyright (C) 1985 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+(defun underline-region (start end)
+  "Underline all nonblank characters in the region.
+Works by overstriking underscores.
+Called from program, takes two arguments START and END
+which specify the range to operate on."
+  (interactive "r")
+  (save-excursion
+   (let ((end1 (make-marker)))
+     (move-marker end1 (max start end))
+     (goto-char (min start end))
+     (while (< (point) end1)
+       (or (looking-at "[_\^@- ]")
+	   (insert "_"))
+       (forward-char 1)))))
+
+(defun ununderline-region (start end)
+  "Remove all underlining (overstruck underscores) in the region.
+Called from program, takes two arguments START and END
+which specify the range to operate on."
+  (interactive "r")
+  (save-excursion
+   (let ((end1 (make-marker)))
+     (move-marker end1 (max start end))
+     (goto-char (min start end))
+     (while (re-search-forward "_\\|_" end1 t)
+       (delete-char -2)))))
diff --git a/lisp/userlock.el b/lisp/userlock.el
new file mode 100644
index 0000000000..e74621675a
--- /dev/null
+++ b/lisp/userlock.el
@@ -0,0 +1,124 @@
+;; Copyright (C) 1985, 1986 Free Software Foundation, inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+;; This file is autloaded to handle certain conditions
+;; detected by the file-locking code within Emacs.
+;; The two entry points are `ask-user-about-lock' and
+;; `ask-user-about-supersession-threat'.
+
+
+(put 'file-locked 'error-conditions '(file-locked file-error error))
+
+(defun ask-user-about-lock (fn opponent)
+  "Ask user what to do when he wants to edit FILE but it is locked by USER.
+This function has a choice of three things to do:
+  do (signal 'buffer-file-locked (list FILE USER))
+    to refrain from editing the file
+  return t (grab the lock on the file)
+  return nil (edit the file even though it is locked).
+You can rewrite it to use any criterion you like to choose which one to do."
+  (discard-input)
+  (save-window-excursion
+    (let (answer)
+      (while (null answer)
+	(message "%s is locking %s: action (s, q, p, ?)? " opponent fn)
+	(let ((tem (let ((inhibit-quit t)
+			 (cursor-in-echo-area t))
+		     (prog1 (downcase (read-char))
+		            (setq quit-flag nil)))))
+	  (if (= tem help-char)
+	      (ask-user-about-lock-help)
+	    (setq answer (assoc tem '((?s . t)
+				      (?q . yield)
+				      (?\C-g . yield)
+				      (?p . nil)
+				      (?? . help))))
+	    (cond ((null answer)
+		   (beep)
+		   (message "Please type q, s, or p; or ? for help")
+		   (sit-for 3))
+		  ((eq (cdr answer) 'help)
+		   (ask-user-about-lock-help)
+		   (setq answer nil))
+		  ((eq (cdr answer) 'yield)
+		   (signal 'file-locked (list "File is locked" fn opponent)))))))
+      (cdr answer))))
+
+(defun ask-user-about-lock-help ()
+  (with-output-to-temp-buffer "*Help*"
+    (princ "It has been detected that you want to modify a file that someone else has
+already started modifying in EMACS.
+
+You can <s>teal the file; The other user becomes the
+  intruder if (s)he ever unmodifies the file and then changes it again.
+You can <p>roceed; you edit at your own (and the other user's) risk.
+You can <q>uit; don't modify this file.")))
+
+(put
+ 'file-supersession 'error-conditions '(file-supersession file-error error))
+
+(defun ask-user-about-supersession-threat (fn)
+  "Ask a user who is about to modify an obsolete buffer what to do.
+This function has two choices: it can return, in which case the modification
+of the buffer will proceed, or it can (signal 'file-supersession (file)),
+in which case the proposed buffer modification will not be made.
+
+You can rewrite this to use any criterion you like to choose which one to do.
+The buffer in question is current when this function is called."
+  (discard-input)
+  (save-window-excursion
+    (let (answer)
+      (while (null answer)
+	(message "File has changed on disk; really want to edit the buffer? (y, n or C-h) ")
+	(let ((tem (downcase (let ((cursor-in-echo-area t))
+			       (read-char)))))
+	  (setq answer
+		(if (= tem help-char)
+		    'help
+		  (cdr (assoc tem '((?n . yield)
+				    (?\C-g . yield)
+				    (?y . proceed)
+				    (?? . help))))))
+	  (cond ((null answer)
+		 (beep)
+		 (message "Please type y or n; or ? for help")
+		 (sit-for 3))
+		((eq answer 'help)
+		 (ask-user-about-supersession-help)
+		 (setq answer nil))
+		((eq answer 'yield)
+		 (signal 'file-supersession
+			 (list "File changed on disk" fn))))))
+      (message
+        "File on disk now will become a backup file if you save these changes.")
+      (setq buffer-backed-up nil))))
+
+(defun ask-user-about-supersession-help ()
+  (with-output-to-temp-buffer "*Help*"
+    (princ "You want to modify a buffer whose disk file has changed
+since you last read it in or saved it with this buffer.
+
+If you say `y' to go ahead and modify this buffer,
+you risk ruining the work of whoever rewrote the file.
+If you say `n', the change you started to make will be aborted.
+
+Usually, you should type `n' and then `M-x revert-buffer',
+to get the latest version of the file, then make the change again.")))
+
+
diff --git a/lisp/vms-patch.el b/lisp/vms-patch.el
new file mode 100644
index 0000000000..1e173e897e
--- /dev/null
+++ b/lisp/vms-patch.el
@@ -0,0 +1,99 @@
+;; Override parts of files.el for VMS.
+;; Copyright (C) 1986 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+;;; Functions that need redefinition
+
+;;; VMS file names are upper case, but buffer names are more
+;;; convenient in lower case.
+
+(defun create-file-buffer (filename)
+  "Create a suitably named buffer for visiting FILENAME, and return it.
+FILENAME (sans directory) is used unchanged if that name is free;
+otherwise a string <2> or <3> or ... is appended to get an unused name."
+  (generate-new-buffer (downcase (file-name-nondirectory filename))))
+
+;;; Given a string FN, return a similar name which is a legal VMS filename.
+;;; This is used to avoid invalid auto save file names.
+(defun make-legal-file-name (fn)
+  (setq fn (copy-sequence fn))
+  (let ((dot nil) (indx 0) (len (length fn)) chr)
+    (while (< indx len)
+      (setq chr (aref fn indx))
+      (cond
+       ((eq chr ?.) (if dot (aset fn indx ?_) (setq dot t)))
+       ((not (or (and (>= chr ?a) (<= chr ?z)) (and (>= chr ?A) (<= chr ?Z))
+		 (and (>= chr ?0) (<= chr ?9))
+		 (eq chr ?$) (eq chr ?_) (and (eq chr ?-) (> indx 0))))
+	(aset fn indx ?_)))
+      (setq indx (1+ indx))))
+  fn)
+
+;;; Auto save filesnames start with _$ and end with $.
+
+(defun make-auto-save-file-name ()
+  "Return file name to use for auto-saves of current buffer.
+Does not consider auto-save-visited-file-name; that is checked
+before calling this function.
+This is a separate function so your .emacs file or site-init.el can redefine it.
+See also auto-save-file-name-p."
+  (if buffer-file-name
+      (concat (file-name-directory buffer-file-name)
+	      "_$"
+	      (file-name-nondirectory buffer-file-name)
+	      "$")
+    (expand-file-name (concat "_$_" (make-legal-file-name (buffer-name)) "$"))))
+
+(defun auto-save-file-name-p (filename)
+  "Return t if FILENAME can be yielded by make-auto-save-file-name.
+FILENAME should lack slashes.
+This is a separate function so your .emacs file or site-init.el can redefine it."
+  (string-match "^_\\$.*\\$" filename))
+
+(defun vms-suspend-resume-hook ()
+  "When resuming suspended Emacs, check for file to be found.
+If the logical name `EMACS_FILE_NAME' is defined, `find-file' that file."
+  (let ((file (vms-system-info "LOGICAL" "EMACS_FILE_NAME")))
+    (if file (find-file file))))
+
+(setq suspend-resume-hook 'vms-suspend-resume-hook)
+
+(defun vms-suspend-hook ()
+  "Don't allow suspending if logical name `DONT_SUSPEND_EMACS' is defined."
+  (if (vms-system-info "LOGICAL" "DONT_SUSPEND_EMACS")
+      (error "Can't suspend this emacs"))
+  nil)
+
+(setq suspend-hook 'vms-suspend-hook)
+
+(defun vms-read-directory (dirname switches buffer)
+  (save-excursion
+    (set-buffer buffer)
+    (subprocess-command-to-buffer
+     (concat "DIRECTORY " switches " " dirname)
+     buffer)
+    (goto-char (point-min))
+    ;; Remove all the trailing blanks.
+    (while (search-forward " \n")
+      (forward-char -1)
+      (delete-horizontal-space))
+    (goto-char (point-min))))
+
+(setq dired-listing-switches
+      "/SIZE/DATE/OWNER/WIDTH=(FILENAME=32,SIZE=5)")
diff --git a/lisp/window.el b/lisp/window.el
new file mode 100644
index 0000000000..ce1c0e566c
--- /dev/null
+++ b/lisp/window.el
@@ -0,0 +1,98 @@
+;; GNU Emacs window commands aside from those written in C.
+;; Copyright (C) 1985, 1989 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+(defun count-windows (&optional minibuf)
+   "Returns the number of visible windows.
+Optional arg NO-MINI non-nil means don't count the minibuffer
+even if it is active."
+   (let ((count 0))
+     (walk-windows (function (lambda ()
+			       (setq count (+ count 1))))
+		   minibuf)
+     count))
+
+(defun balance-windows ()
+  "Makes all visible windows the same size (approximately)."
+  (interactive)
+  (let ((count 0))
+    (walk-windows (function (lambda (w)
+			      (setq count (+ count 1))))
+		  'nomini)
+    (let ((size (/ (screen-height) count)))
+      (walk-windows (function (lambda (w)
+				(select-window w)
+				(enlarge-window (- size (window-height)))))
+		    'nomini))))
+
+(defun split-window-vertically (&optional arg)
+  "Split current window into two windows, one above the other.
+This window becomes the uppermost of the two, and gets
+ARG lines.  No arg means split equally."
+  (interactive "P")
+  (let ((old-w (selected-window))
+	new-w bottom)
+    (setq new-w (split-window nil (and arg (prefix-numeric-value arg))))
+    (save-excursion
+      (set-buffer (window-buffer))
+      (goto-char (window-start))
+      (vertical-motion (window-height))
+      (set-window-start new-w (point))
+      (if (> (point) (window-point new-w))
+	  (set-window-point new-w (point)))
+      (vertical-motion -1)
+      (setq bottom (point)))
+    (if (<= bottom (point))
+	(set-window-point old-w (1- bottom)))))
+
+(defun split-window-horizontally (&optional arg)
+  "Split current window into two windows side by side.
+This window becomes the leftmost of the two, and gets
+ARG columns.  No arg means split equally."
+  (interactive "P")
+  (split-window nil (and arg (prefix-numeric-value arg)) t))
+
+(defun enlarge-window-horizontally (arg)
+  "Make current window ARG columns wider."
+  (interactive "p")
+  (enlarge-window arg t))
+
+(defun shrink-window-horizontally (arg)
+  "Make current window ARG columns narrower."
+  (interactive "p")
+  (shrink-window arg t))
+
+(defun window-config-to-register (name)
+  "Save the current window configuration in register REG (a letter).
+It can be later retrieved using \\[M-x register-to-window-config]."
+  (interactive "cSave window configuration in register: ")
+  (set-register name (current-window-configuration)))
+
+(defun register-to-window-config (name)
+  "Restore (make current) the window configuration in register REG (a letter).
+Use with a register previously set with \\[window-config-to-register]."
+  (interactive "cRestore window configuration from register: ")
+  (set-window-configuration (get-register name)))
+
+(define-key ctl-x-map "2" 'split-window-vertically)
+(define-key ctl-x-map "5" 'split-window-horizontally)
+(define-key ctl-x-map "6" 'window-config-to-register)
+(define-key ctl-x-map "7" 'register-to-window-config)
+(define-key ctl-x-map "}" 'enlarge-window-horizontally)
+(define-key ctl-x-map "{" 'shrink-window-horizontally)