Moved from lisp/.

9 files changed, 2713 insertions, 0 deletions

diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el
new file mode 100644
index 00000000000..a28f89cd91a
--- /dev/null
+++ b/lisp/emacs-lisp/byte-run.el
@@ -0,0 +1,172 @@
+;;; byte-run.el --- byte-compiler support for inlining
+
+;; Copyright (C) 1992 Free Software Foundation, Inc.
+
+;; Author: Jamie Zawinski <jwz@lucid.com>
+;;	Hallvard Furuseth <hbf@ulrik.uio.no>
+;; Maintainer: FSF
+;; Keywords: internal
+
+;; 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 2, 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, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; interface to selectively inlining functions.
+;; This only happens when source-code optimization is turned on.
+
+;;; Code:
+
+;; Redefined in byte-optimize.el.
+;; This is not documented--it's not clear that we should promote it.
+(fset 'inline 'progn)
+(put 'inline 'lisp-indent-hook 0)
+
+
+;;; Interface to inline functions.
+
+;; (defmacro proclaim-inline (&rest fns)
+;;   "Cause the named functions to be open-coded when called from compiled code.
+;; They will only be compiled open-coded when byte-compile-optimize is true."
+;;   (cons 'eval-and-compile
+;; 	(mapcar '(lambda (x)
+;; 		   (or (memq (get x 'byte-optimizer)
+;; 			     '(nil byte-compile-inline-expand))
+;; 		       (error
+;; 			"%s already has a byte-optimizer, can't make it inline"
+;; 			x))
+;; 		   (list 'put (list 'quote x)
+;; 			 ''byte-optimizer ''byte-compile-inline-expand))
+;; 		fns)))
+
+;; (defmacro proclaim-notinline (&rest fns)
+;;   "Cause the named functions to no longer be open-coded."
+;;   (cons 'eval-and-compile
+;; 	(mapcar '(lambda (x)
+;; 		   (if (eq (get x 'byte-optimizer) 'byte-compile-inline-expand)
+;; 		       (put x 'byte-optimizer nil))
+;; 		   (list 'if (list 'eq (list 'get (list 'quote x) ''byte-optimizer)
+;; 				   ''byte-compile-inline-expand)
+;; 			 (list 'put x ''byte-optimizer nil)))
+;; 		fns)))
+
+;; This has a special byte-hunk-handler in bytecomp.el.
+(defmacro defsubst (name arglist &rest body)
+  "Define an inline function.  The syntax is just like that of `defun'."
+  (or (memq (get name 'byte-optimizer)
+	    '(nil byte-compile-inline-expand))
+      (error "`%s' is a primitive" name))
+  (list 'prog1
+	(cons 'defun (cons name (cons arglist body)))
+	(list 'eval-and-compile
+	      (list 'put (list 'quote name)
+		    ''byte-optimizer ''byte-compile-inline-expand))))
+
+(defun make-obsolete (fn new &optional when)
+  "Make the byte-compiler warn that FUNCTION is obsolete.
+The warning will say that NEW should be used instead.
+If NEW is a string, that is the `use instead' message.
+If provided, WHEN should be a string indicating when the function
+was first made obsolete, for example a date or a release number."
+  (interactive "aMake function obsolete: \nxObsoletion replacement: ")
+  (let ((handler (get fn 'byte-compile)))
+    (if (eq 'byte-compile-obsolete handler)
+	(setq handler (nth 1 (get fn 'byte-obsolete-info)))
+      (put fn 'byte-compile 'byte-compile-obsolete))
+    (put fn 'byte-obsolete-info (list new handler when)))
+  fn)
+
+(defun make-obsolete-variable (var new &optional when)
+  "Make the byte-compiler warn that VARIABLE is obsolete,
+and NEW should be used instead.  If NEW is a string, then that is the
+`use instead' message.
+If provided, WHEN should be a string indicating when the variable
+was first made obsolete, for example a date or a release number."
+  (interactive
+   (list
+    (let ((str (completing-read "Make variable obsolete: " obarray 'boundp t)))
+      (if (equal str "") (error ""))
+      (intern str))
+    (car (read-from-string (read-string "Obsoletion replacement: ")))))
+  (put var 'byte-obsolete-variable (cons new when))
+  var)
+
+(put 'dont-compile 'lisp-indent-hook 0)
+(defmacro dont-compile (&rest body)
+  "Like `progn', but the body always runs interpreted (not compiled).
+If you think you need this, you're probably making a mistake somewhere."
+  (list 'eval (list 'quote (if (cdr body) (cons 'progn body) (car body)))))
+
+
+;;; interface to evaluating things at compile time and/or load time
+;;; these macro must come after any uses of them in this file, as their
+;;; definition in the file overrides the magic definitions on the
+;;; byte-compile-macro-environment.
+
+(put 'eval-when-compile 'lisp-indent-hook 0)
+(defmacro eval-when-compile (&rest body)
+  "Like `progn', but evaluates the body at compile time.
+The result of the body appears to the compiler as a quoted constant."
+  ;; Not necessary because we have it in b-c-initial-macro-environment
+  ;; (list 'quote (eval (cons 'progn body)))
+  (cons 'progn body))
+
+(put 'eval-and-compile 'lisp-indent-hook 0)
+(defmacro eval-and-compile (&rest body)
+  "Like `progn', but evaluates the body at compile time and at load time."
+  ;; Remember, it's magic.
+  (cons 'progn body))
+
+(defun with-no-warnings (&optional first &rest body)
+  "Like `progn', but prevents compiler warnings in the body."
+  ;; The implementation for the interpreter is basically trivial.
+  (if body (car (last body))
+    first))
+
+
+;;; I nuked this because it's not a good idea for users to think of using it.
+;;; These options are a matter of installation preference, and have nothing to
+;;; with particular source files; it's a mistake to suggest to users
+;;; they should associate these with particular source files.
+;;; There is hardly any reason to change these parameters, anyway.
+;;; --rms.
+
+;; (put 'byte-compiler-options 'lisp-indent-hook 0)
+;; (defmacro byte-compiler-options (&rest args)
+;;   "Set some compilation-parameters for this file.  This will affect only the
+;; file in which it appears; this does nothing when evaluated, and when loaded
+;; from a .el file.
+;;
+;; Each argument to this macro must be a list of a key and a value.
+;;
+;;   Keys:		  Values:		Corresponding variable:
+;;
+;;   verbose	  t, nil		byte-compile-verbose
+;;   optimize	  t, nil, source, byte	byte-compile-optimize
+;;   warnings	  list of warnings	byte-compile-warnings
+;; 		      Legal elements: (callargs redefine free-vars unresolved)
+;;   file-format	  emacs18, emacs19	byte-compile-compatibility
+;;
+;; For example, this might appear at the top of a source file:
+;;
+;;     (byte-compiler-options
+;;       (optimize t)
+;;       (warnings (- free-vars))		; Don't warn about free variables
+;;       (file-format emacs19))"
+;;   nil)
+
+;;; byte-run.el ends here
diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el
new file mode 100644
index 00000000000..8d152f391bc
--- /dev/null
+++ b/lisp/emacs-lisp/derived.el
@@ -0,0 +1,436 @@
+;;; derived.el --- allow inheritance of major modes
+;;; (formerly mode-clone.el)
+
+;; Copyright (C) 1993, 1994, 1999, 2003 Free Software Foundation, Inc.
+
+;; Author: David Megginson (dmeggins@aix1.uottawa.ca)
+;; Maintainer: FSF
+;; Keywords: extensions
+
+;; 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 2, 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, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; GNU Emacs is already, in a sense, object oriented -- each object
+;; (buffer) belongs to a class (major mode), and that class defines
+;; the relationship between messages (input events) and methods
+;; (commands) by means of a keymap.
+;;
+;; The only thing missing is a good scheme of inheritance.  It is
+;; possible to simulate a single level of inheritance with generous
+;; use of hooks and a bit of work -- sgml-mode, for example, also runs
+;; the hooks for text-mode, and keymaps can inherit from other keymaps
+;; -- but generally, each major mode ends up reinventing the wheel.
+;; Ideally, someone should redesign all of Emacs's major modes to
+;; follow a more conventional object-oriented system: when defining a
+;; new major mode, the user should need only to name the existing mode
+;; it is most similar to, then list the (few) differences.
+;;
+;; In the mean time, this package offers most of the advantages of
+;; full inheritance with the existing major modes.  The macro
+;; `define-derived-mode' allows the user to make a variant of an existing
+;; major mode, with its own keymap.  The new mode will inherit the key
+;; bindings of its parent, and will, in fact, run its parent first
+;; every time it is called.  For example, the commands
+;;
+;;  (define-derived-mode hypertext-mode text-mode "Hypertext"
+;;    "Major mode for hypertext.\n\n\\{hypertext-mode-map}"
+;;    (setq case-fold-search nil))
+;;
+;;  (define-key hypertext-mode-map [down-mouse-3] 'do-hyper-link)
+;;
+;; will create a function `hypertext-mode' with its own (sparse)
+;; keymap `hypertext-mode-map.'  The command M-x hypertext-mode will
+;; perform the following actions:
+;;
+;; - run the command (text-mode) to get its default setup
+;; - replace the current keymap with 'hypertext-mode-map,' which will
+;;   inherit from 'text-mode-map'.
+;; - replace the current syntax table with
+;;   'hypertext-mode-syntax-table', which will borrow its defaults
+;;   from the current text-mode-syntax-table.
+;; - replace the current abbrev table with
+;;   'hypertext-mode-abbrev-table', which will borrow its defaults
+;;   from the current text-mode-abbrev table
+;; - change the mode line to read "Hypertext"
+;; - assign the value 'hypertext-mode' to the 'major-mode' variable
+;; - run the body of commands provided in the macro -- in this case,
+;;   set the local variable `case-fold-search' to nil.
+;;
+;; The advantages of this system are threefold.  First, text mode is
+;; untouched -- if you had added the new keystroke to `text-mode-map,'
+;; possibly using hooks, you would have added it to all text buffers
+;; -- here, it appears only in hypertext buffers, where it makes
+;; sense.  Second, it is possible to build even further, and make
+;; a derived mode from a derived mode.  The commands
+;;
+;;   (define-derived-mode html-mode hypertext-mode "HTML")
+;;   [various key definitions]
+;;
+;; will add a new major mode for HTML with very little fuss.
+;;
+;; Note also the function `derived-mode-p' which can tell if the current
+;; mode derives from another.  In a hypertext-mode, buffer, for example,
+;; (derived-mode-p 'text-mode) would return non-nil.  This should always
+;; be used in place of (eq major-mode 'text-mode).
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+;;; PRIVATE: defsubst must be defined before they are first used
+
+(defsubst derived-mode-hook-name (mode)
+  "Construct the mode hook name based on mode name MODE."
+  (intern (concat (symbol-name mode) "-hook")))
+
+(defsubst derived-mode-map-name (mode)
+  "Construct a map name based on a MODE name."
+  (intern (concat (symbol-name mode) "-map")))
+
+(defsubst derived-mode-syntax-table-name (mode)
+  "Construct a syntax-table name based on a MODE name."
+  (intern (concat (symbol-name mode) "-syntax-table")))
+
+(defsubst derived-mode-abbrev-table-name (mode)
+  "Construct an abbrev-table name based on a MODE name."
+  (intern (concat (symbol-name mode) "-abbrev-table")))
+
+;; PUBLIC: define a new major mode which inherits from an existing one.
+
+;;;###autoload
+(defmacro define-derived-mode (child parent name &optional docstring &rest body)
+  "Create a new mode as a variant of an existing mode.
+
+The arguments to this command are as follow:
+
+CHILD:     the name of the command for the derived mode.
+PARENT:    the name of the command for the parent mode (e.g. `text-mode')
+           or nil if there is no parent.
+NAME:      a string which will appear in the status line (e.g. \"Hypertext\")
+DOCSTRING: an optional documentation string--if you do not supply one,
+           the function will attempt to invent something useful.
+BODY:      forms to execute just before running the
+           hooks for the new mode.  Do not use `interactive' here.
+
+BODY can start with a bunch of keyword arguments.  The following keyword
+  arguments are currently understood:
+:group GROUP
+	Declare the customization group that corresponds to this mode.
+:syntax-table TABLE
+	Use TABLE instead of the default.
+	A nil value means to simply use the same syntax-table as the parent.
+:abbrev-table TABLE
+	Use TABLE instead of the default.
+	A nil value means to simply use the same abbrev-table as the parent.
+
+Here is how you could define LaTeX-Thesis mode as a variant of LaTeX mode:
+
+  (define-derived-mode LaTeX-thesis-mode LaTeX-mode \"LaTeX-Thesis\")
+
+You could then make new key bindings for `LaTeX-thesis-mode-map'
+without changing regular LaTeX mode.  In this example, BODY is empty,
+and DOCSTRING is generated by default.
+
+On a more complicated level, the following command uses `sgml-mode' as
+the parent, and then sets the variable `case-fold-search' to nil:
+
+  (define-derived-mode article-mode sgml-mode \"Article\"
+    \"Major mode for editing technical articles.\"
+    (setq case-fold-search nil))
+
+Note that if the documentation string had been left out, it would have
+been generated automatically, with a reference to the keymap."
+  (declare (debug (&define name symbolp sexp [&optional stringp]
+			   [&rest keywordp sexp] def-body)))
+
+  (when (and docstring (not (stringp docstring)))
+    ;; Some trickiness, since what appears to be the docstring may really be
+    ;; the first element of the body.
+    (push docstring body)
+    (setq docstring nil))
+
+  (when (eq parent 'fundamental-mode) (setq parent nil))
+
+  (let ((map (derived-mode-map-name child))
+	(syntax (derived-mode-syntax-table-name child))
+	(abbrev (derived-mode-abbrev-table-name child))
+	(declare-abbrev t)
+	(declare-syntax t)
+	(hook (derived-mode-hook-name child))
+	(group nil))
+
+    ;; Process the keyword args.
+    (while (keywordp (car body))
+      (case (pop body)
+	(:group (setq group (pop body)))
+	(:abbrev-table (setq abbrev (pop body)) (setq declare-abbrev nil))
+	(:syntax-table (setq syntax (pop body)) (setq declare-syntax nil))
+	(t (pop body))))
+
+    (setq docstring (derived-mode-make-docstring
+		     parent child docstring syntax abbrev))
+
+    `(progn
+       (defvar ,map (make-sparse-keymap))
+       ,(if declare-syntax
+	    `(defvar ,syntax (make-syntax-table)))
+       ,(if declare-abbrev
+	    `(defvar ,abbrev
+	       (progn (define-abbrev-table ',abbrev nil) ,abbrev)))
+       (put ',child 'derived-mode-parent ',parent)
+       ,(if group `(put ',child 'custom-mode-group ,group))
+
+       (defun ,child ()
+	 ,docstring
+	 (interactive)
+					; Run the parent.
+	 (delay-mode-hooks
+
+	  (,(or parent 'kill-all-local-variables))
+					; Identify the child mode.
+	  (setq major-mode (quote ,child))
+	  (setq mode-name ,name)
+					; Identify special modes.
+	  ,(when parent
+	     `(progn
+		(if (get (quote ,parent) 'mode-class)
+		    (put (quote ,child) 'mode-class
+			 (get (quote ,parent) 'mode-class)))
+					; Set up maps and tables.
+		(unless (keymap-parent ,map)
+		  (set-keymap-parent ,map (current-local-map)))
+		,(when declare-syntax
+		   `(let ((parent (char-table-parent ,syntax)))
+		      (unless (and parent
+				   (not (eq parent (standard-syntax-table))))
+			(set-char-table-parent ,syntax (syntax-table)))))))
+
+	  (use-local-map ,map)
+	  ,(when syntax `(set-syntax-table ,syntax))
+	  ,(when abbrev `(setq local-abbrev-table ,abbrev))
+					; Splice in the body (if any).
+	  ,@body
+	  )
+	 ;; Run the hooks, if any.
+	 ;; Make the generated code work in older Emacs versions
+	 ;; that do not yet have run-mode-hooks.
+	 (if (fboundp 'run-mode-hooks)
+	     (run-mode-hooks ',hook)
+	   (run-hooks ',hook))))))
+
+;; PUBLIC: find the ultimate class of a derived mode.
+
+(defun derived-mode-class (mode)
+  "Find the class of a major MODE.
+A mode's class is the first ancestor which is NOT a derived mode.
+Use the `derived-mode-parent' property of the symbol to trace backwards.
+Since major-modes might all derive from `fundamental-mode', this function
+is not very useful."
+  (while (get mode 'derived-mode-parent)
+    (setq mode (get mode 'derived-mode-parent)))
+  mode)
+(make-obsolete 'derived-mode-class 'derived-mode-p "21.4")
+
+
+;;; PRIVATE
+
+(defun derived-mode-make-docstring (parent child &optional
+					   docstring syntax abbrev)
+  "Construct a docstring for a new mode if none is provided."
+
+  (let ((map (derived-mode-map-name child))
+	(hook (derived-mode-hook-name child)))
+
+    (unless (stringp docstring)
+      ;; Use a default docstring.
+      (setq docstring
+	    (if (null parent)
+		(format "Major-mode.
+Uses keymap `%s', abbrev table `%s' and syntax-table `%s'." map abbrev syntax)
+	      (format "Major mode derived from `%s' by `define-derived-mode'.
+It inherits all of the parent's attributes, but has its own keymap,
+abbrev table and syntax table:
+
+  `%s', `%s' and `%s'
+
+which more-or-less shadow %s's corresponding tables."
+		      parent map abbrev syntax parent))))
+
+    (unless (string-match (regexp-quote (symbol-name hook)) docstring)
+      ;; Make sure the docstring mentions the mode's hook.
+      (setq docstring
+	    (concat docstring
+		    (if (null parent)
+			"\n\nThis mode "
+		      (concat
+		       "\n\nIn addition to any hooks its parent mode "
+		       (if (string-match (regexp-quote (format "`%s'" parent))
+					 docstring) nil
+			 (format "`%s' " parent))
+		       "might have run,\nthis mode "))
+		    (format "runs the hook `%s'" hook)
+		    ", as the final step\nduring initialization.")))
+
+    (unless (string-match "\\\\[{[]" docstring)
+      ;; And don't forget to put the mode's keymap.
+      (setq docstring (concat docstring "\n\n\\{" (symbol-name map) "}")))
+
+    docstring))
+
+
+;;; OBSOLETE
+;; The functions below are only provided for backward compatibility with
+;; code byte-compiled with versions of derived.el prior to Emacs-21.
+
+(defsubst derived-mode-setup-function-name (mode)
+  "Construct a setup-function name based on a MODE name."
+  (intern (concat (symbol-name mode) "-setup")))
+
+
+;; Utility functions for defining a derived mode.
+
+;;;###autoload
+(defun derived-mode-init-mode-variables (mode)
+  "Initialise variables for a new MODE.
+Right now, if they don't already exist, set up a blank keymap, an
+empty syntax table, and an empty abbrev table -- these will be merged
+the first time the mode is used."
+
+  (if (boundp (derived-mode-map-name mode))
+      t
+    (eval `(defvar ,(derived-mode-map-name mode)
+	       (make-sparse-keymap)
+	       ,(format "Keymap for %s." mode)))
+    (put (derived-mode-map-name mode) 'derived-mode-unmerged t))
+
+  (if (boundp (derived-mode-syntax-table-name mode))
+      t
+    (eval `(defvar ,(derived-mode-syntax-table-name mode)
+	     ;; Make a syntax table which doesn't specify anything
+	     ;; for any char.  Valid data will be merged in by
+	     ;; derived-mode-merge-syntax-tables.
+	     (make-char-table 'syntax-table nil)
+	     ,(format "Syntax table for %s." mode)))
+    (put (derived-mode-syntax-table-name mode) 'derived-mode-unmerged t))
+
+  (if (boundp (derived-mode-abbrev-table-name mode))
+      t
+    (eval `(defvar ,(derived-mode-abbrev-table-name mode)
+	     (progn
+	       (define-abbrev-table (derived-mode-abbrev-table-name mode) nil)
+	       (make-abbrev-table))
+	     ,(format "Abbrev table for %s." mode)))))
+
+;; Utility functions for running a derived mode.
+
+(defun derived-mode-set-keymap (mode)
+  "Set the keymap of the new MODE, maybe merging with the parent."
+  (let* ((map-name (derived-mode-map-name mode))
+	 (new-map (eval map-name))
+	 (old-map (current-local-map)))
+    (and old-map
+	 (get map-name 'derived-mode-unmerged)
+	 (derived-mode-merge-keymaps old-map new-map))
+    (put map-name 'derived-mode-unmerged nil)
+    (use-local-map new-map)))
+
+(defun derived-mode-set-syntax-table (mode)
+  "Set the syntax table of the new MODE, maybe merging with the parent."
+  (let* ((table-name (derived-mode-syntax-table-name mode))
+	 (old-table (syntax-table))
+	 (new-table (eval table-name)))
+    (if (get table-name 'derived-mode-unmerged)
+	(derived-mode-merge-syntax-tables old-table new-table))
+    (put table-name 'derived-mode-unmerged nil)
+    (set-syntax-table new-table)))
+
+(defun derived-mode-set-abbrev-table (mode)
+  "Set the abbrev table for MODE if it exists.
+Always merge its parent into it, since the merge is non-destructive."
+  (let* ((table-name (derived-mode-abbrev-table-name mode))
+	 (old-table local-abbrev-table)
+	 (new-table (eval table-name)))
+    (derived-mode-merge-abbrev-tables old-table new-table)
+    (setq local-abbrev-table new-table)))
+
+;;;(defun derived-mode-run-setup-function (mode)
+;;;  "Run the setup function if it exists."
+
+;;;  (let ((fname (derived-mode-setup-function-name mode)))
+;;;    (if (fboundp fname)
+;;;	(funcall fname))))
+
+(defun derived-mode-run-hooks (mode)
+  "Run the mode hook for MODE."
+  (let ((hooks-name (derived-mode-hook-name mode)))
+    (if (boundp hooks-name)
+	(run-hooks hooks-name))))
+
+;; Functions to merge maps and tables.
+
+(defun derived-mode-merge-keymaps (old new)
+  "Merge an OLD keymap into a NEW one.
+The old keymap is set to be the last cdr of the new one, so that there will
+be automatic inheritance."
+  ;; ?? Can this just use `set-keymap-parent'?
+  (let ((tail new))
+    ;; Scan the NEW map for prefix keys.
+    (while (consp tail)
+      (and (consp (car tail))
+	   (let* ((key (vector (car (car tail))))
+		  (subnew (lookup-key new key))
+		  (subold (lookup-key old key)))
+	     ;; If KEY is a prefix key in both OLD and NEW, merge them.
+	     (and (keymapp subnew) (keymapp subold)
+		  (derived-mode-merge-keymaps subold subnew))))
+      (and (vectorp (car tail))
+	   ;; Search a vector of ASCII char bindings for prefix keys.
+	   (let ((i (1- (length (car tail)))))
+	     (while (>= i 0)
+	       (let* ((key (vector i))
+		      (subnew (lookup-key new key))
+		      (subold (lookup-key old key)))
+		 ;; If KEY is a prefix key in both OLD and NEW, merge them.
+		 (and (keymapp subnew) (keymapp subold)
+		      (derived-mode-merge-keymaps subold subnew)))
+	       (setq i (1- i)))))
+      (setq tail (cdr tail))))
+  (setcdr (nthcdr (1- (length new)) new) old))
+
+(defun derived-mode-merge-syntax-tables (old new)
+  "Merge an OLD syntax table into a NEW one.
+Where the new table already has an entry, nothing is copied from the old one."
+  (set-char-table-parent new old))
+
+;; Merge an old abbrev table into a new one.
+;; This function requires internal knowledge of how abbrev tables work,
+;; presuming that they are obarrays with the abbrev as the symbol, the expansion
+;; as the value of the symbol, and the hook as the function definition.
+(defun derived-mode-merge-abbrev-tables (old new)
+  (if old
+      (mapatoms
+       (lambda (symbol)
+	 (or (intern-soft (symbol-name symbol) new)
+	     (define-abbrev new (symbol-name symbol)
+	       (symbol-value symbol) (symbol-function symbol))))
+       old)))
+
+(provide 'derived)
+
+;;; derived.el ends here
diff --git a/lisp/emacs-lisp/float-sup.el b/lisp/emacs-lisp/float-sup.el
new file mode 100644
index 00000000000..4c45112e980
--- /dev/null
+++ b/lisp/emacs-lisp/float-sup.el
@@ -0,0 +1,63 @@
+;;; float-sup.el --- define some constants useful for floating point numbers.
+
+;; Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.
+
+;; Maintainer: FSF
+;; Keywords: internal
+
+;; 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 2, 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, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+;; Provide a meaningful error message if we are running on
+;; bare (non-float) emacs.
+
+(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.
+;; 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...).")
+;; It's too inconvenient to make `e' a constant because it's used as
+;; a temporary variable all the time.
+(defvar 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))
+
+(provide 'lisp-float-type)
+
+;;; float-sup.el ends here
diff --git a/lisp/emacs-lisp/map-ynp.el b/lisp/emacs-lisp/map-ynp.el
new file mode 100644
index 00000000000..2fa97f163d7
--- /dev/null
+++ b/lisp/emacs-lisp/map-ynp.el
@@ -0,0 +1,264 @@
+;;; map-ynp.el --- general-purpose boolean question-asker
+
+;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 2000 Free Software Foundation, Inc.
+
+;; Author: Roland McGrath <roland@gnu.org>
+;; Maintainer: FSF
+;; Keywords: lisp, extensions
+
+;; 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 2, 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, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; map-y-or-n-p is a general-purpose question-asking function.
+;; It asks a series of y/n questions (a la y-or-n-p), and decides to
+;; apply an action to each element of a list based on the answer.
+;; The nice thing is that you also get some other possible answers
+;; to use, reminiscent of query-replace: ! to answer y to all remaining
+;; questions; ESC or q to answer n to all remaining questions; . to answer
+;; y once and then n for the remainder; and you can get help with C-h.
+
+;;; Code:
+
+(defun map-y-or-n-p (prompter actor list &optional help action-alist
+			      no-cursor-in-echo-area)
+  "Ask a series of boolean questions.
+Takes args PROMPTER ACTOR LIST, and optional args HELP and ACTION-ALIST.
+
+LIST is a list of objects, or a function of no arguments to return the next
+object or nil.
+
+If PROMPTER is a string, the prompt is \(format PROMPTER OBJECT\).  If not
+a string, PROMPTER is a function of one arg (an object from LIST), which
+returns a string to be used as the prompt for that object.  If the return
+value is not a string, it may be nil to ignore the object or non-nil to act
+on the object without asking the user.
+
+ACTOR is a function of one arg (an object from LIST),
+which gets called with each object that the user answers `yes' for.
+
+If HELP is given, it is a list (OBJECT OBJECTS ACTION),
+where OBJECT is a string giving the singular noun for an elt of LIST;
+OBJECTS is the plural noun for elts of LIST, and ACTION is a transitive
+verb describing ACTOR.  The default is \(\"object\" \"objects\" \"act on\"\).
+
+At the prompts, the user may enter y, Y, or SPC to act on that object;
+n, N, or DEL to skip that object; ! to act on all following objects;
+ESC or q to exit (skip all following objects); . (period) to act on the
+current object and then exit; or \\[help-command] to get help.
+
+If ACTION-ALIST is given, it is an alist (KEY FUNCTION HELP) of extra keys
+that will be accepted.  KEY is a character; FUNCTION is a function of one
+arg (an object from LIST); HELP is a string.  When the user hits KEY,
+FUNCTION is called.  If it returns non-nil, the object is considered
+\"acted upon\", and the next object from LIST is processed.  If it returns
+nil, the prompt is repeated for the same object.
+
+Final optional argument NO-CURSOR-IN-ECHO-AREA non-nil says not to set
+`cursor-in-echo-area' while prompting.
+
+This function uses `query-replace-map' to define the standard responses,
+but not all of the responses which `query-replace' understands
+are meaningful here.
+
+Returns the number of actions taken."
+  (let* ((actions 0)
+	 user-keys mouse-event map prompt char elt tail def
+	 ;; Non-nil means we should use mouse menus to ask.
+	 use-menus
+	 delayed-switch-frame
+	 (next (if (or (and list (symbolp list))
+		       (subrp list)
+		       (byte-code-function-p list)
+		       (and (consp list)
+			    (eq (car list) 'lambda)))
+		   (function (lambda ()
+			       (setq elt (funcall list))))
+		 (function (lambda ()
+			     (if list
+				 (progn
+				   (setq elt (car list)
+					 list (cdr list))
+				   t)
+			       nil))))))
+    (if (and (listp last-nonmenu-event)
+	     use-dialog-box)
+	;; Make a list describing a dialog box.
+	(let ((object (if help (capitalize (nth 0 help))))
+	      (objects (if help (capitalize (nth 1 help))))
+	      (action (if help (capitalize (nth 2 help)))))
+	  (setq map `(("Yes" . act) ("No" . skip) ("Quit" . exit)
+		      (,(if help (concat action " " object " And Quit")
+			  "Do it and Quit") . act-and-exit)
+		      (,(if help (concat action " All " objects)
+			  "Do All") . automatic)
+		      ,@(mapcar (lambda (elt)
+				  (cons (capitalize (nth 2 elt))
+					(vector (nth 1 elt))))
+				action-alist))
+		use-menus t
+		mouse-event last-nonmenu-event))
+      (setq user-keys (if action-alist
+			  (concat (mapconcat (function
+					      (lambda (elt)
+						(key-description
+						 (char-to-string (car elt)))))
+					     action-alist ", ")
+				  " ")
+			"")
+	    ;; Make a map that defines each user key as a vector containing
+	    ;; its definition.
+	    map (cons 'keymap
+		      (append (mapcar (lambda (elt)
+					(cons (car elt) (vector (nth 1 elt))))
+				      action-alist)
+			      query-replace-map))))
+    (unwind-protect
+	(progn
+	  (if (stringp prompter)
+	      (setq prompter `(lambda (object)
+				(format ,prompter object))))
+	  (while (funcall next)
+	    (setq prompt (funcall prompter elt))
+	    (cond ((stringp prompt)
+		   ;; Prompt the user about this object.
+		   (setq quit-flag nil)
+		   (if use-menus
+		       (setq def (or (x-popup-dialog (or mouse-event use-menus)
+						     (cons prompt map))
+				     'quit))
+		     ;; Prompt in the echo area.
+		     (let ((cursor-in-echo-area (not no-cursor-in-echo-area))
+			   (message-log-max nil))
+		       (message "%s(y, n, !, ., q, %sor %s) "
+				prompt user-keys
+				(key-description (vector help-char)))
+		       (if minibuffer-auto-raise
+			   (raise-frame (window-frame (minibuffer-window))))
+		       (while (progn
+				(setq char (read-event))
+				;; If we get -1, from end of keyboard
+				;; macro, try again.
+                                (equal char -1)))
+		       ;; Show the answer to the question.
+		       (message "%s(y, n, !, ., q, %sor %s) %s"
+				prompt user-keys
+				(key-description (vector help-char))
+				(single-key-description char)))
+		     (setq def (lookup-key map (vector char))))
+		   (cond ((eq def 'exit)
+			  (setq next (function (lambda () nil))))
+			 ((eq def 'act)
+			  ;; Act on the object.
+			  (funcall actor elt)
+			  (setq actions (1+ actions)))
+			 ((eq def 'skip)
+			  ;; Skip the object.
+			  )
+			 ((eq def 'act-and-exit)
+			  ;; Act on the object and then exit.
+			  (funcall actor elt)
+			  (setq actions (1+ actions)
+				next (function (lambda () nil))))
+			 ((eq def 'quit)
+			  (setq quit-flag t)
+			  (setq next `(lambda ()
+					(setq next ',next)
+					',elt)))
+			 ((eq def 'automatic)
+			  ;; Act on this and all following objects.
+			  (if (funcall prompter elt)
+			      (progn
+				(funcall actor elt)
+				(setq actions (1+ actions))))
+			  (while (funcall next)
+			    (if (funcall prompter elt)
+				(progn
+				  (funcall actor elt)
+				  (setq actions (1+ actions))))))
+			 ((eq def 'help)
+			  (with-output-to-temp-buffer "*Help*"
+			    (princ
+			     (let ((object (if help (nth 0 help) "object"))
+				   (objects (if help (nth 1 help) "objects"))
+				   (action (if help (nth 2 help) "act on")))
+			       (concat
+				(format "Type SPC or `y' to %s the current %s;
+DEL or `n' to skip the current %s;
+RET or `q' to exit (skip all remaining %s);
+C-g to quit (cancel the operation);
+! to %s all remaining %s;\n"
+					action object object objects action
+					objects)
+				(mapconcat (function
+					    (lambda (elt)
+					      (format "%s to %s"
+						      (single-key-description
+						       (nth 0 elt))
+						      (nth 2 elt))))
+					   action-alist
+					   ";\n")
+				(if action-alist ";\n")
+				(format "or . (period) to %s \
+the current %s and exit."
+					action object))))
+			    (save-excursion
+			      (set-buffer standard-output)
+			      (help-mode)))
+
+			  (setq next `(lambda ()
+				       (setq next ',next)
+				       ',elt)))
+			 ((vectorp def)
+			  ;; A user-defined key.
+			  (if (funcall (aref def 0) elt) ;Call its function.
+			      ;; The function has eaten this object.
+			      (setq actions (1+ actions))
+			    ;; Regurgitated; try again.
+			    (setq next `(lambda ()
+					 (setq next ',next)
+					 ',elt))))
+			 ((and (consp char)
+			       (eq (car char) 'switch-frame))
+			  ;; switch-frame event.  Put it off until we're done.
+			  (setq delayed-switch-frame char)
+			  (setq next `(lambda ()
+				       (setq next ',next)
+				       ',elt)))
+			 (t
+			  ;; Random char.
+			  (message "Type %s for help."
+				   (key-description (vector help-char)))
+			  (beep)
+			  (sit-for 1)
+			  (setq next `(lambda ()
+				       (setq next ',next)
+				       ',elt)))))
+		  (prompt
+		   (funcall actor elt)
+		   (setq actions (1+ actions))))))
+      (if delayed-switch-frame
+	  (setq unread-command-events
+		(cons delayed-switch-frame unread-command-events))))
+    ;; Clear the last prompt from the minibuffer.
+    (let ((message-log-max nil))
+      (message ""))
+    ;; Return the number of actions that were taken.
+    actions))
+
+;;; map-ynp.el ends here
diff --git a/lisp/emacs-lisp/regi.el b/lisp/emacs-lisp/regi.el
new file mode 100644
index 00000000000..c0cae5b5771
--- /dev/null
+++ b/lisp/emacs-lisp/regi.el
@@ -0,0 +1,258 @@
+;;; regi.el --- REGular expression Interpreting engine
+
+;; Copyright (C) 1993 Free Software Foundation, Inc.
+
+;; Author: 1993 Barry A. Warsaw, Century Computing, Inc. <bwarsaw@cen.com>
+;; Maintainer:    bwarsaw@cen.com
+;; Created:       24-Feb-1993
+;; Version:       1.8
+;; Last Modified: 1993/06/01 21:33:00
+;; Keywords:      extensions, matching
+
+;; 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 2, 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, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+
+(defun regi-pos (&optional position col-p)
+  "Return the character position at various buffer positions.
+Optional POSITION can be one of the following symbols:
+
+`bol'  == beginning of line
+`boi'  == beginning of indentation
+`eol'  == end of line [default]
+`bonl' == beginning of next line
+`bopl' == beginning of previous line
+
+Optional COL-P non-nil returns `current-column' instead of character position."
+  (save-excursion
+    (cond
+     ((eq position 'bol)  (beginning-of-line))
+     ((eq position 'boi)  (back-to-indentation))
+     ((eq position 'bonl) (forward-line 1))
+     ((eq position 'bopl) (forward-line -1))
+     (t (end-of-line)))
+    (if col-p (current-column) (point))))
+
+(defun regi-mapcar (predlist func &optional negate-p case-fold-search-p)
+  "Build a regi frame where each element of PREDLIST appears exactly once.
+The frame contains elements where each member of PREDLIST is
+associated with FUNC, and optionally NEGATE-P and CASE-FOLD-SEARCH-P."
+  (let (frame tail)
+    (if (or negate-p case-fold-search-p)
+	(setq tail (list negate-p)))
+    (if case-fold-search-p
+	(setq tail (append tail (list case-fold-search-p))))
+    (while predlist
+      (let ((element (list (car predlist) func)))
+	(if tail
+	    (setq element (append element tail)))
+	(setq frame (append frame (list element))
+	      predlist (cdr predlist))
+	))
+    frame))
+
+
+(defun regi-interpret (frame &optional start end)
+  "Interpret the regi frame FRAME.
+If optional START and END are supplied, they indicate the region of
+interest, and the buffer is narrowed to the beginning of the line
+containing START, and beginning of the line after the line containing
+END.  Otherwise, point and mark are not set and processing continues
+until your FUNC returns the `abort' symbol (see below).  Beware!  Not
+supplying a START or END could put you in an infinite loop.
+
+A regi frame is a list of entries of the form:
+
+     (PRED FUNC [NEGATE-P [CASE-FOLD-SEARCH]])
+
+PRED is a predicate against which each line in the region is tested,
+and if a match occurs, FUNC is `eval'd.  Point is then moved to the
+beginning of the next line, the frame is reset and checking continues.
+If a match doesn't occur, the next entry is checked against the
+current line until all entries in the frame are checked.  At this
+point, if no match occurred, the frame is reset and point is moved to
+the next line.  Checking continues until every line in the region is
+checked.  Optional NEGATE-P inverts the result of PRED before FUNC is
+called and `case-fold-search' is bound to the optional value of
+CASE-FOLD-SEARCH for the PRED check.
+
+PRED can be a string, variable, function or one of the following
+symbols: t, nil, `begin', `end', and `every'.  If PRED is a string, or
+a variable or list that evaluates to a string, it is interpreted as a
+regular expression and is matched against the current line (from the
+beginning) using `looking-at'.  If PRED does not evaluate to a string,
+it is interpreted as a binary value (nil or non-nil).
+
+PRED can also be one of the following symbols:
+
+t       -- always produces a true outcome
+`begin' -- always executes before anything else
+`end'   -- always executes after everything else
+`every' -- execute after frame is matched on a line
+
+Note that NEGATE-P and CASE-FOLD-SEARCH are meaningless if PRED is one
+of these special symbols.  Only the first occurrence of each symbol in
+a frame entry is used, the rest are ignored.
+
+Your FUNC can return values which control regi processing.  If a list
+is returned from your function, it can contain any combination of the
+following elements:
+
+the symbol `continue'
+     Tells regi to continue processing frame-entries after a match,
+     instead of resetting to the first entry and advancing to the next
+     line, as is the default behavior.  When returning this symbol,
+     you must take care not to enter an infinite loop.
+
+the symbol `abort'
+     Tells regi to terminate processing this frame.  any end
+     frame-entry is still processed.
+
+the list `(frame . NEWFRAME)'
+     Tells regi to use NEWFRAME as its current frame.  In other words,
+     your FUNC can modify the executing regi frame on the fly.
+
+the list `(step . STEP)'
+     Tells regi to move STEP number of lines forward during normal
+     processing.  By default, regi moves forward 1 line.  STEP can be
+     negative, but be careful of infinite loops.
+
+You should usually take care to explicitly return nil from your
+function if no action is to take place.  Your FUNC will always be
+`eval'ed.  The following variables will be temporarily bound to some
+useful information:
+
+`curline'
+     the current line in the buffer, as a string
+
+`curframe'
+     the full, current frame being executed
+
+`curentry'
+     the current frame entry being executed."
+
+  (save-excursion
+    (save-restriction
+      (let (begin-tag end-tag every-tag current-frame working-frame donep)
+
+	;; set up the narrowed region
+	(and start
+	     end
+	     (let* ((tstart start)
+		    (start (min start end))
+		    (end   (max start end)))
+	       (narrow-to-region
+		(progn (goto-char end) (regi-pos 'bonl))
+		(progn (goto-char start) (regi-pos 'bol)))))
+
+	;; lets find the special tags and remove them from the working
+	;; frame. note that only the last special tag is used.
+	(mapcar
+	 (function
+	  (lambda (entry)
+	    (let ((pred (car entry))
+		  (func (car (cdr entry))))
+	      (cond
+	       ((eq pred 'begin) (setq begin-tag func))
+	       ((eq pred 'end)   (setq end-tag func))
+	       ((eq pred 'every) (setq every-tag func))
+	       (t
+		(setq working-frame (append working-frame (list entry))))
+	       ) ; end-cond
+	      )))
+	 frame) ; end-mapcar
+
+	;; execute the begin entry
+	(eval begin-tag)
+
+	;; now process the frame
+	(setq current-frame working-frame)
+	(while (not (or donep (eobp)))
+	  (let* ((entry            (car current-frame))
+		 (pred             (nth 0 entry))
+		 (func             (nth 1 entry))
+		 (negate-p         (nth 2 entry))
+		 (case-fold-search (nth 3 entry))
+		 match-p)
+	    (catch 'regi-throw-top
+	      (cond
+	       ;; we are finished processing the frame for this line
+	       ((not current-frame)
+		(setq current-frame working-frame) ;reset frame
+		(forward-line 1)
+		(throw 'regi-throw-top t))
+	       ;; see if predicate evaluates to a string
+	       ((stringp (setq match-p (eval pred)))
+		(setq match-p (looking-at match-p)))
+	       ) ; end-cond
+
+	      ;; now that we've done the initial matching, check for
+	      ;; negation of match
+	      (and negate-p
+		   (setq match-p (not match-p)))
+
+	      ;; if the line matched, package up the argument list and
+	      ;; funcall the FUNC
+	      (if match-p
+		   (let* ((curline (buffer-substring
+				    (regi-pos 'bol)
+				    (regi-pos 'eol)))
+			  (curframe current-frame)
+			  (curentry entry)
+			  (result (eval func))
+			  (step (or (cdr (assq 'step result)) 1))
+			  )
+		     ;; changing frame on the fly?
+		     (if (assq 'frame result)
+			 (setq working-frame (cdr (assq 'frame result))))
+
+		     ;; continue processing current frame?
+		     (if (memq 'continue result)
+			 (setq current-frame (cdr current-frame))
+		       (forward-line step)
+		       (setq current-frame working-frame))
+
+		     ;; abort current frame?
+		     (if (memq 'abort result)
+			 (progn
+			   (setq donep t)
+			   (throw 'regi-throw-top t)))
+		     ) ; end-let
+
+		;; else if no match occurred, then process the next
+		;; frame-entry on the current line
+		(setq current-frame (cdr current-frame))
+
+		) ; end-if match-p
+	      ) ; end catch
+	    ) ; end let
+
+	  ;; after every cycle, evaluate every-tag
+	  (eval every-tag)
+	  ) ; end-while
+
+	;; now process the end entry
+	(eval end-tag)))))
+
+
+(provide 'regi)
+
+;;; regi.el ends here
diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el
new file mode 100644
index 00000000000..b7db0d01dc1
--- /dev/null
+++ b/lisp/emacs-lisp/timer.el
@@ -0,0 +1,479 @@
+;;; timer.el --- run a function with args at some time in future
+
+;; Copyright (C) 1996 Free Software Foundation, Inc.
+
+;; Maintainer: FSF
+
+;; 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 2, 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, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This package gives you the capability to run Emacs Lisp commands at
+;; specified times in the future, either as one-shots or periodically.
+
+;;; Code:
+
+;; Layout of a timer vector:
+;; [triggered-p high-seconds low-seconds usecs repeat-delay
+;;  function args idle-delay]
+
+(defun timer-create ()
+  "Create a timer object."
+  (let ((timer (make-vector 8 nil)))
+    (aset timer 0 t)
+    timer))
+
+(defun timerp (object)
+  "Return t if OBJECT is a timer."
+  (and (vectorp object) (= (length object) 8)))
+
+(defun timer-set-time (timer time &optional delta)
+  "Set the trigger time of TIMER to TIME.
+TIME must be in the internal format returned by, e.g., `current-time'.
+If optional third argument DELTA is a positive number, make the timer
+fire repeatedly that many seconds apart."
+  (or (timerp timer)
+      (error "Invalid timer"))
+  (aset timer 1 (car time))
+  (aset timer 2 (if (consp (cdr time)) (car (cdr time)) (cdr time)))
+  (aset timer 3 (or (and (consp (cdr time)) (consp (cdr (cdr time)))
+			 (nth 2 time))
+		    0))
+  (aset timer 4 (and (numberp delta) (> delta 0) delta))
+  timer)
+
+(defun timer-set-idle-time (timer secs &optional repeat)
+  "Set the trigger idle time of TIMER to SECS.
+If optional third argument REPEAT is non-nil, make the timer
+fire each time Emacs is idle for that many seconds."
+  (or (timerp timer)
+      (error "Invalid timer"))
+  (aset timer 1 0)
+  (aset timer 2 0)
+  (aset timer 3 0)
+  (timer-inc-time timer secs)
+  (aset timer 4 repeat)
+  timer)
+
+(defun timer-next-integral-multiple-of-time (time secs)
+  "Yield the next value after TIME that is an integral multiple of SECS.
+More precisely, the next value, after TIME, that is an integral multiple
+of SECS seconds since the epoch.  SECS may be a fraction."
+  (let ((time-base (ash 1 16)))
+    (if (fboundp 'atan)
+	;; Use floating point, taking care to not lose precision.
+	(let* ((float-time-base (float time-base))
+	       (million 1000000.0)
+	       (time-usec (+ (* million
+				(+ (* float-time-base (nth 0 time))
+				   (nth 1 time)))
+			     (nth 2 time)))
+	       (secs-usec (* million secs))
+	       (mod-usec (mod time-usec secs-usec))
+	       (next-usec (+ (- time-usec mod-usec) secs-usec))
+	       (time-base-million (* float-time-base million)))
+	  (list (floor next-usec time-base-million)
+		(floor (mod next-usec time-base-million) million)
+		(floor (mod next-usec million))))
+      ;; Floating point is not supported.
+      ;; Use integer arithmetic, avoiding overflow if possible.
+      (let* ((mod-sec (mod (+ (* (mod time-base secs)
+				 (mod (nth 0 time) secs))
+			      (nth 1 time))
+			   secs))
+	     (next-1-sec (+ (- (nth 1 time) mod-sec) secs)))
+	(list (+ (nth 0 time) (floor next-1-sec time-base))
+	      (mod next-1-sec time-base)
+	      0)))))
+
+(defun timer-relative-time (time secs &optional usecs)
+  "Advance TIME by SECS seconds and optionally USECS microseconds.
+SECS may be a fraction."
+  (let ((high (car time))
+	(low (if (consp (cdr time)) (nth 1 time) (cdr time)))
+	(micro (if (numberp (car-safe (cdr-safe (cdr time))))
+		   (nth 2 time)
+		 0)))
+    ;; Add
+    (if usecs (setq micro (+ micro usecs)))
+    (if (floatp secs)
+	(setq micro (+ micro (floor (* 1000000 (- secs (floor secs)))))))
+    (setq low (+ low (floor secs)))
+
+    ;; Normalize
+    ;; `/' rounds towards zero while `mod' returns a positive number,
+    ;; so we can't rely on (= a (+ (* 100 (/ a 100)) (mod a 100))).
+    (setq low (+ low (/ micro 1000000) (if (< micro 0) -1 0)))
+    (setq micro (mod micro 1000000))
+    (setq high (+ high (/ low 65536) (if (< low 0) -1 0)))
+    (setq low (logand low 65535))
+
+    (list high low (and (/= micro 0) micro))))
+
+(defun timer-inc-time (timer secs &optional usecs)
+  "Increment the time set in TIMER by SECS seconds and USECS microseconds.
+SECS may be a fraction.  If USECS is omitted, that means it is zero."
+  (let ((time (timer-relative-time
+	       (list (aref timer 1) (aref timer 2) (aref timer 3))
+	       secs
+	       usecs)))
+    (aset timer 1 (nth 0 time))
+    (aset timer 2 (nth 1 time))
+    (aset timer 3 (or (nth 2 time) 0))))
+
+(defun timer-set-time-with-usecs (timer time usecs &optional delta)
+  "Set the trigger time of TIMER to TIME plus USECS.
+TIME must be in the internal format returned by, e.g., `current-time'.
+The microsecond count from TIME is ignored, and USECS is used instead.
+If optional fourth argument DELTA is a positive number, make the timer
+fire repeatedly that many seconds apart."
+  (or (timerp timer)
+      (error "Invalid timer"))
+  (aset timer 1 (nth 0 time))
+  (aset timer 2 (nth 1 time))
+  (aset timer 3 usecs)
+  (aset timer 4 (and (numberp delta) (> delta 0) delta))
+  timer)
+(make-obsolete 'timer-set-time-with-usecs
+               "use `timer-set-time' and `timer-inc-time' instead."
+               "21.4")
+
+(defun timer-set-function (timer function &optional args)
+  "Make TIMER call FUNCTION with optional ARGS when triggering."
+  (or (timerp timer)
+      (error "Invalid timer"))
+  (aset timer 5 function)
+  (aset timer 6 args)
+  timer)
+
+(defun timer-activate (timer)
+  "Put TIMER on the list of active timers."
+  (if (and (timerp timer)
+	   (integerp (aref timer 1))
+	   (integerp (aref timer 2))
+	   (integerp (aref timer 3))
+	   (aref timer 5))
+      (let ((timers timer-list)
+	    last)
+	;; Skip all timers to trigger before the new one.
+	(while (and timers
+		    (or (> (aref timer 1) (aref (car timers) 1))
+			(and (= (aref timer 1) (aref (car timers) 1))
+			     (> (aref timer 2) (aref (car timers) 2)))
+			(and (= (aref timer 1) (aref (car timers) 1))
+			     (= (aref timer 2) (aref (car timers) 2))
+			     (> (aref timer 3) (aref (car timers) 3)))))
+	  (setq last timers
+		timers (cdr timers)))
+	;; Insert new timer after last which possibly means in front of queue.
+	(if last
+	    (setcdr last (cons timer timers))
+	  (setq timer-list (cons timer timers)))
+	(aset timer 0 nil)
+	(aset timer 7 nil)
+	nil)
+    (error "Invalid or uninitialized timer")))
+
+(defun timer-activate-when-idle (timer &optional dont-wait)
+  "Arrange to activate TIMER whenever Emacs is next idle.
+If optional argument DONT-WAIT is non-nil, then enable the
+timer to activate immediately, or at the right time, if Emacs
+is already idle."
+  (if (and (timerp timer)
+	   (integerp (aref timer 1))
+	   (integerp (aref timer 2))
+	   (integerp (aref timer 3))
+	   (aref timer 5))
+      (let ((timers timer-idle-list)
+	    last)
+	;; Skip all timers to trigger before the new one.
+	(while (and timers
+		    (or (> (aref timer 1) (aref (car timers) 1))
+			(and (= (aref timer 1) (aref (car timers) 1))
+			     (> (aref timer 2) (aref (car timers) 2)))
+			(and (= (aref timer 1) (aref (car timers) 1))
+			     (= (aref timer 2) (aref (car timers) 2))
+			     (> (aref timer 3) (aref (car timers) 3)))))
+	  (setq last timers
+		timers (cdr timers)))
+	;; Insert new timer after last which possibly means in front of queue.
+	(if last
+	    (setcdr last (cons timer timers))
+	  (setq timer-idle-list (cons timer timers)))
+	(aset timer 0 (not dont-wait))
+	(aset timer 7 t)
+	nil)
+    (error "Invalid or uninitialized timer")))
+
+;;;###autoload
+(defalias 'disable-timeout 'cancel-timer)
+;;;###autoload
+(defun cancel-timer (timer)
+  "Remove TIMER from the list of active timers."
+  (or (timerp timer)
+      (error "Invalid timer"))
+  (setq timer-list (delq timer timer-list))
+  (setq timer-idle-list (delq timer timer-idle-list))
+  nil)
+
+;;;###autoload
+(defun cancel-function-timers (function)
+  "Cancel all timers scheduled by `run-at-time' which would run FUNCTION."
+  (interactive "aCancel timers of function: ")
+  (let ((tail timer-list))
+    (while tail
+      (if (eq (aref (car tail) 5) function)
+          (setq timer-list (delq (car tail) timer-list)))
+      (setq tail (cdr tail))))
+  (let ((tail timer-idle-list))
+    (while tail
+      (if (eq (aref (car tail) 5) function)
+          (setq timer-idle-list (delq (car tail) timer-idle-list)))
+      (setq tail (cdr tail)))))
+
+;; Record the last few events, for debugging.
+(defvar timer-event-last-2 nil)
+(defvar timer-event-last-1 nil)
+(defvar timer-event-last nil)
+
+(defvar timer-max-repeats 10
+  "*Maximum number of times to repeat a timer, if real time jumps.")
+
+(defun timer-until (timer time)
+  "Calculate number of seconds from when TIMER will run, until TIME.
+TIMER is a timer, and stands for the time when its next repeat is scheduled.
+TIME is a time-list."
+  (let ((high (- (car time) (aref timer 1)))
+	(low (- (nth 1 time) (aref timer 2))))
+    (+ low (* high 65536))))
+
+(defun timer-event-handler (timer)
+  "Call the handler for the timer TIMER.
+This function is called, by name, directly by the C code."
+  (setq timer-event-last-2 timer-event-last-1)
+  (setq timer-event-last-1 timer-event-last)
+  (setq timer-event-last timer)
+  (let ((inhibit-quit t))
+    (if (timerp timer)
+	(progn
+	  ;; Delete from queue.
+	  (cancel-timer timer)
+	  ;; Re-schedule if requested.
+	  (if (aref timer 4)
+	      (if (aref timer 7)
+		  (timer-activate-when-idle timer)
+		(timer-inc-time timer (aref timer 4) 0)
+		;; If real time has jumped forward,
+		;; perhaps because Emacs was suspended for a long time,
+		;; limit how many times things get repeated.
+		(if (and (numberp timer-max-repeats)
+			 (< 0 (timer-until timer (current-time))))
+		    (let ((repeats (/ (timer-until timer (current-time))
+				      (aref timer 4))))
+		      (if (> repeats timer-max-repeats)
+			  (timer-inc-time timer (* (aref timer 4) repeats)))))
+		(timer-activate timer)))
+	  ;; Run handler.
+	  ;; We do this after rescheduling so that the handler function
+	  ;; can cancel its own timer successfully with cancel-timer.
+	  (condition-case nil
+	      (apply (aref timer 5) (aref timer 6))
+	    (error nil)))
+      (error "Bogus timer event"))))
+
+;; This function is incompatible with the one in levents.el.
+(defun timeout-event-p (event)
+  "Non-nil if EVENT is a timeout event."
+  (and (listp event) (eq (car event) 'timer-event)))
+
+;;;###autoload
+(defun run-at-time (time repeat function &rest args)
+  "Perform an action at time TIME.
+Repeat the action every REPEAT seconds, if REPEAT is non-nil.
+TIME should be a string like \"11:23pm\", nil meaning now, a number of seconds
+from now, a value from `current-time', or t (with non-nil REPEAT)
+meaning the next integral multiple of REPEAT.
+REPEAT may be an integer or floating point number.
+The action is to call FUNCTION with arguments ARGS.
+
+This function returns a timer object which you can use in `cancel-timer'."
+  (interactive "sRun at time: \nNRepeat interval: \naFunction: ")
+
+  (or (null repeat)
+      (and (numberp repeat) (< 0 repeat))
+      (error "Invalid repetition interval"))
+
+  ;; Special case: nil means "now" and is useful when repeating.
+  (if (null time)
+      (setq time (current-time)))
+
+  ;; Special case: t means the next integral multiple of REPEAT.
+  (if (and (eq time t) repeat)
+      (setq time (timer-next-integral-multiple-of-time (current-time) repeat)))
+
+  ;; Handle numbers as relative times in seconds.
+  (if (numberp time)
+      (setq time (timer-relative-time (current-time) time)))
+
+  ;; Handle relative times like "2 hours and 35 minutes"
+  (if (stringp time)
+      (let ((secs (timer-duration time)))
+	(if secs
+	    (setq time (timer-relative-time (current-time) secs)))))
+
+  ;; Handle "11:23pm" and the like.  Interpret it as meaning today
+  ;; which admittedly is rather stupid if we have passed that time
+  ;; already.  (Though only Emacs hackers hack Emacs at that time.)
+  (if (stringp time)
+      (progn
+	(require 'diary-lib)
+	(let ((hhmm (diary-entry-time time))
+	      (now (decode-time)))
+	  (if (>= hhmm 0)
+	      (setq time
+		    (encode-time 0 (% hhmm 100) (/ hhmm 100) (nth 3 now)
+				 (nth 4 now) (nth 5 now) (nth 8 now)))))))
+
+  (or (consp time)
+      (error "Invalid time format"))
+
+  (let ((timer (timer-create)))
+    (timer-set-time timer time repeat)
+    (timer-set-function timer function args)
+    (timer-activate timer)
+    timer))
+
+;;;###autoload
+(defun run-with-timer (secs repeat function &rest args)
+  "Perform an action after a delay of SECS seconds.
+Repeat the action every REPEAT seconds, if REPEAT is non-nil.
+SECS and REPEAT may be integers or floating point numbers.
+The action is to call FUNCTION with arguments ARGS.
+
+This function returns a timer object which you can use in `cancel-timer'."
+  (interactive "sRun after delay (seconds): \nNRepeat interval: \naFunction: ")
+  (apply 'run-at-time secs repeat function args))
+
+;;;###autoload
+(defun add-timeout (secs function object &optional repeat)
+  "Add a timer to run SECS seconds from now, to call FUNCTION on OBJECT.
+If REPEAT is non-nil, repeat the timer every REPEAT seconds.
+This function is for compatibility; see also `run-with-timer'."
+  (run-with-timer secs repeat function object))
+
+;;;###autoload
+(defun run-with-idle-timer (secs repeat function &rest args)
+  "Perform an action the next time Emacs is idle for SECS seconds.
+The action is to call FUNCTION with arguments ARGS.
+SECS may be an integer or a floating point number.
+
+If REPEAT is non-nil, do the action each time Emacs has been idle for
+exactly SECS seconds (that is, only once for each time Emacs becomes idle).
+
+This function returns a timer object which you can use in `cancel-timer'."
+  (interactive
+   (list (read-from-minibuffer "Run after idle (seconds): " nil nil t)
+	 (y-or-n-p "Repeat each time Emacs is idle? ")
+	 (intern (completing-read "Function: " obarray 'fboundp t))))
+  (let ((timer (timer-create)))
+    (timer-set-function timer function args)
+    (timer-set-idle-time timer secs repeat)
+    (timer-activate-when-idle timer)
+    timer))
+
+(defun with-timeout-handler (tag)
+  (throw tag 'timeout))
+
+;;;###autoload (put 'with-timeout 'lisp-indent-function 1)
+
+;;;###autoload
+(defmacro with-timeout (list &rest body)
+  "Run BODY, but if it doesn't finish in SECONDS seconds, give up.
+If we give up, we run the TIMEOUT-FORMS and return the value of the last one.
+The call should look like:
+ (with-timeout (SECONDS TIMEOUT-FORMS...) BODY...)
+The timeout is checked whenever Emacs waits for some kind of external
+event \(such as keyboard input, input from subprocesses, or a certain time);
+if the program loops without waiting in any way, the timeout will not
+be detected."
+  (let ((seconds (car list))
+	(timeout-forms (cdr list)))
+    `(let ((with-timeout-tag (cons nil nil))
+	   with-timeout-value with-timeout-timer)
+       (if (catch with-timeout-tag
+	     (progn
+	       (setq with-timeout-timer
+		     (run-with-timer ,seconds nil
+				      'with-timeout-handler
+				      with-timeout-tag))
+	       (setq with-timeout-value (progn . ,body))
+	       nil))
+	   (progn . ,timeout-forms)
+	 (cancel-timer with-timeout-timer)
+	 with-timeout-value))))
+
+(defun y-or-n-p-with-timeout (prompt seconds default-value)
+  "Like (y-or-n-p PROMPT), with a timeout.
+If the user does not answer after SECONDS seconds, return DEFAULT-VALUE."
+  (with-timeout (seconds default-value)
+    (y-or-n-p prompt)))
+
+(defvar timer-duration-words
+  (list (cons "microsec" 0.000001)
+	(cons "microsecond" 0.000001)
+        (cons "millisec" 0.001)
+	(cons "millisecond" 0.001)
+        (cons "sec" 1)
+	(cons "second" 1)
+	(cons "min" 60)
+	(cons "minute" 60)
+	(cons "hour" (* 60 60))
+	(cons "day" (* 24 60 60))
+	(cons "week" (* 7 24 60 60))
+	(cons "fortnight" (* 14 24 60 60))
+	(cons "month" (* 30 24 60 60))	  ; Approximation
+	(cons "year" (* 365.25 24 60 60)) ; Approximation
+	)
+  "Alist mapping temporal words to durations in seconds")
+
+(defun timer-duration (string)
+  "Return number of seconds specified by STRING, or nil if parsing fails."
+  (let ((secs 0)
+	(start 0)
+	(case-fold-search t))
+    (while (string-match
+	    "[ \t]*\\([0-9.]+\\)?[ \t]*\\([a-z]+[a-rt-z]\\)s?[ \t]*"
+	    string start)
+      (let ((count (if (match-beginning 1)
+		       (string-to-number (match-string 1 string))
+		     1))
+	    (itemsize (cdr (assoc (match-string 2 string)
+				  timer-duration-words))))
+	(if itemsize
+	    (setq start (match-end 0)
+		  secs (+ secs (* count itemsize)))
+	  (setq secs nil
+		start (length string)))))
+    (if (= start (length string))
+	secs
+      (if (string-match "\\`[0-9.]+\\'" string)
+	  (string-to-number string)))))
+
+(provide 'timer)
+
+;;; timer.el ends here
diff --git a/lisp/emacs-lisp/warnings.el b/lisp/emacs-lisp/warnings.el
new file mode 100644
index 00000000000..4d0354236a8
--- /dev/null
+++ b/lisp/emacs-lisp/warnings.el
@@ -0,0 +1,311 @@
+;;; warnings.el --- log and display warnings
+
+;; Copyright (C) 2002 Free Software Foundation, Inc.
+
+;; Maintainer: FSF
+;; Keywords: internal
+
+;; 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 2, 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, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This file implements the entry points `warn', `lwarn'
+;; and `display-warnings'.
+
+;;; Code:
+
+(defgroup warnings nil
+  "Log and display warnings."
+  :version "21.4"
+  :group 'lisp)
+
+(defvar warning-levels
+  '((:emergency "Emergency%s: " ding)
+    (:error "Error%s: ")
+    (:warning "Warning%s: ")
+    (:debug "Debug%s: "))
+  "List of severity level definitions for `display-warning'.
+Each element looks like (LEVEL STRING FUNCTION) and
+defines LEVEL as a severity level.  STRING specifies the
+description of this level.  STRING should use `%s' to
+specify where to put the warning group information,
+or it can omit the `%s' so as not to include that information.
+
+The optional FUNCTION, if non-nil, is a function to call
+with no arguments, to get the user's attention.
+
+The standard levels are :emergency, :error, :warning and :debug.
+See `display-warning' for documentation of their meanings.
+Level :debug is ignored by default (see `warning-minimum-level').")
+(put 'warning-levels 'risky-local-variable t)
+
+;; These are for compatibility with XEmacs.
+;; I don't think there is any chance of designing meaningful criteria
+;; to distinguish so many levels.
+(defvar warning-level-aliases
+  '((emergency . :emergency)
+    (error . :error)
+    (warning . :warning)
+    (notice . :warning)
+    (info . :warning)
+    (critical . :emergency)
+    (alarm . :emergency))
+  "Alist of aliases for severity levels for `display-warning'.
+Each element looks like (ALIAS . LEVEL) and defines
+ALIAS as equivalent to LEVEL.  LEVEL must be defined in `warning-levels';
+it may not itself be an alias.")
+
+(defcustom warning-minimum-level :warning
+  "Minimum severity level for displaying the warning buffer.
+If a warning's severity level is lower than this,
+the warning is logged in the warnings buffer, but the buffer
+is not immediately displayed.  See also `warning-minimum-log-level'."
+  :group 'warnings
+  :type '(choice (const :emergency) (const :error) (const :warning))
+  :version "21.4")
+(defvaralias 'display-warning-minimum-level 'warning-minimum-level)
+
+(defcustom warning-minimum-log-level :warning
+  "Minimum severity level for logging a warning.
+If a warning severity level is lower than this,
+the warning is completely ignored."
+  :group 'warnings
+  :type '(choice (const :emergency) (const :error) (const :warning))
+  :version "21.4")
+(defvaralias 'log-warning-minimum-level 'warning-minimum-log-level)
+
+(defcustom warning-suppress-log-types nil
+  "List of warning types that should not be logged.
+If any element of this list matches the GROUP argument to `display-warning',
+the warning is completely ignored.
+The element must match the first elements of GROUP.
+Thus, (foo bar) as an element matches (foo bar)
+or (foo bar ANYTHING...) as GROUP.
+If GROUP is a symbol FOO, that is equivalent to the list (FOO),
+so only the element (FOO) will match it."
+  :group 'warnings
+  :type '(repeat (repeat symbol))
+  :version "21.4")
+
+(defcustom warning-suppress-types nil
+  "Custom groups for warnings not to display immediately.
+If any element of this list matches the GROUP argument to `display-warning',
+the warning is logged nonetheless, but the warnings buffer is
+not immediately displayed.
+The element must match an initial segment of the list GROUP.
+Thus, (foo bar) as an element matches (foo bar)
+or (foo bar ANYTHING...) as GROUP.
+If GROUP is a symbol FOO, that is equivalent to the list (FOO),
+so only the element (FOO) will match it.
+See also `warning-suppress-log-types'."
+  :group 'warnings
+  :type '(repeat (repeat symbol))
+  :version "21.4")
+
+;;; The autoload cookie is so that programs can bind this variable
+;;; safely, testing the existing value, before they call one of the
+;;; warnings functions.
+;;;###autoload
+(defvar warning-prefix-function nil
+  "Function to generate warning prefixes.
+This function, if non-nil, is called with two arguments,
+the severity level and its entry in `warning-levels',
+and should return the entry that should actually be used.
+The warnings buffer is current when this function is called
+and the function can insert text in it.  This text becomes
+the beginning of the warning.")
+
+;;; The autoload cookie is so that programs can bind this variable
+;;; safely, testing the existing value, before they call one of the
+;;; warnings functions.
+;;;###autoload
+(defvar warning-series nil
+  "Non-nil means treat multiple `display-warning' calls as a series.
+A marker indicates a position in the warnings buffer
+which is the start of the current series; it means that
+additional warnings in the same buffer should not move point.
+t means the next warning begins a series (and stores a marker here).
+A symbol with a function definition is like t, except
+also call that function before the next warning.")
+(put 'warning-series 'risky-local-variable t)
+
+;;; The autoload cookie is so that programs can bind this variable
+;;; safely, testing the existing value, before they call one of the
+;;; warnings functions.
+;;;###autoload
+(defvar warning-fill-prefix nil
+  "Non-nil means fill each warning text using this string as `fill-prefix'.")
+
+;;; The autoload cookie is so that programs can bind this variable
+;;; safely, testing the existing value, before they call one of the
+;;; warnings functions.
+;;;###autoload
+(defvar warning-group-format " (%s)"
+  "Format for displaying the warning group in the warning message.
+The result of formatting the group this way gets included in the
+message under the control of the string in `warning-levels'.")
+
+(defun warning-numeric-level (level)
+  "Return a numeric measure of the warning severity level LEVEL."
+  (let* ((elt (assq level warning-levels))
+	 (link (memq elt warning-levels)))
+    (length link)))
+
+(defun warning-suppress-p (group suppress-list)
+  "Non-nil if a warning with group GROUP should be suppressed.
+SUPPRESS-LIST is the list of kinds of warnings to suppress."
+  (let (some-match)
+    (dolist (elt suppress-list)
+      (if (symbolp group)
+	  ;; If GROUP is a symbol, the ELT must be (GROUP).
+	  (if (and (consp elt)
+		   (eq (car elt) group)
+		   (null (cdr elt)))
+	      (setq some-match t))
+	;; If GROUP is a list, ELT must match it or some initial segment of it.
+	(let ((tem1 group)
+	      (tem2 elt)
+	      (match t))
+	  ;; Check elements of ELT until we run out of them.
+	  (while tem2
+	    (if (not (equal (car tem1) (car tem2)))
+		(setq match nil))
+	    (setq tem1 (cdr tem1)
+		  tem2 (cdr tem2)))
+	  ;; If ELT is an initial segment of GROUP, MATCH is t now.
+	  ;; So set SOME-MATCH.
+	  (if match
+	      (setq some-match t)))))
+    ;; If some element of SUPPRESS-LIST matched,
+    ;; we return t.
+    some-match))
+
+;;;###autoload
+(defun display-warning (group message &optional level buffer-name)
+  "Display a warning message, MESSAGE.
+GROUP should be a custom group name (a symbol),
+or else a list of symbols whose first element is a custom group name.
+\(The rest of the symbols represent subcategories, for warning purposes
+only, and you can use whatever symbols you like.)
+
+LEVEL should be either :warning, :error, or :emergency.
+:emergency -- a problem that will seriously impair Emacs operation soon
+	      if you do not attend to it promptly.
+:error     -- data or circumstances that are inherently wrong.
+:warning   -- data or circumstances that are not inherently wrong,
+	      but raise suspicion of a possible problem.
+:debug     -- info for debugging only.
+
+BUFFER-NAME, if specified, is the name of the buffer for logging the
+warning.  By default, it is `*Warnings*'.
+
+See the `warnings' custom group for user customization features.
+
+See also `warning-series', `warning-prefix-function' and
+`warning-fill-prefix' for additional programming features."
+  (unless level
+    (setq level :warning))
+  (if (assq level warning-level-aliases)
+      (setq level (cdr (assq level warning-level-aliases))))
+  (or (< (warning-numeric-level level)
+	 (warning-numeric-level warning-minimum-log-level))
+      (warning-suppress-p group warning-suppress-log-types)
+      (let* ((groupname (if (consp group) (car group) group))
+	     (buffer (get-buffer-create (or buffer-name "*Warnings*")))
+	     (level-info (assq level warning-levels))
+	     start end)
+	(with-current-buffer buffer
+	  (goto-char (point-max))
+	  (when (and warning-series (symbolp warning-series))
+	    (setq warning-series
+		  (prog1 (point-marker)
+		    (unless (eq warning-series t)
+		      (funcall warning-series)))))
+	  (unless (bolp)
+	    (newline))
+	  (setq start (point))
+	  (if warning-prefix-function
+	      (setq level-info (funcall warning-prefix-function
+					level level-info)))
+	  (insert (format (nth 1 level-info)
+                          (format warning-group-format groupname))
+		  message)
+	  (newline)
+	  (when (and warning-fill-prefix (not (string-match "\n" message)))
+	    (let ((fill-prefix warning-fill-prefix)
+		  (fill-column 78))
+	      (fill-region start (point))))
+	  (setq end (point))
+	  (when (and (markerp warning-series)
+		     (eq (marker-buffer warning-series) buffer))
+	    (goto-char warning-series)))
+	(if (nth 2 level-info)
+	    (funcall (nth 2 level-info)))
+	(if noninteractive
+	    ;; Noninteractively, take the text we inserted
+	    ;; in the warnings buffer and print it.
+	    ;; Do this unconditionally, since there is no way
+	    ;; to view logged messages unless we output them.
+	    (with-current-buffer buffer
+	      (save-excursion
+		;; Don't include the final newline in the arg
+		;; to `message', because it adds a newline.
+		(goto-char end)
+		(if (bolp)
+		    (forward-char -1))
+		(message "%s" (buffer-substring start (point)))))
+	  ;; Interactively, decide whether the warning merits
+	  ;; immediate display.
+	  (or (< (warning-numeric-level level)
+		 (warning-numeric-level warning-minimum-level))
+	      (warning-suppress-p group warning-suppress-types)
+	      (let ((window (display-buffer buffer)))
+		(when (and (markerp warning-series)
+			   (eq (marker-buffer warning-series) buffer))
+		  (set-window-start window warning-series))
+		(sit-for 0)))))))
+
+;;;###autoload
+(defun lwarn (group level message &rest args)
+  "Display a warning message made from (format MESSAGE ARGS...).
+Aside from generating the message with `format',
+this is equivalent to `display-warning'.
+
+GROUP should be a custom group name (a symbol).
+or else a list of symbols whose first element is a custom group name.
+\(The rest of the symbols represent subcategories and
+can be whatever you like.)
+
+LEVEL should be either :warning, :error, or :emergency.
+:emergency -- a problem that will seriously impair Emacs operation soon
+	      if you do not attend to it promptly.
+:error     -- invalid data or circumstances.
+:warning   -- suspicious data or circumstances."
+  (display-warning group (apply 'format message args) level))
+
+;;;###autoload
+(defun warn (message &rest args)
+  "Display a warning message made from (format MESSAGE ARGS...).
+Aside from generating the message with `format',
+this is equivalent to `display-warning', using
+`emacs' as the group and `:warning' as the level."
+  (display-warning 'emacs (apply 'format message args)))
+
+(provide 'warnings)
+
+;;; warnings.el ends here
diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el
new file mode 100644
index 00000000000..4b1dfca6f5b
--- /dev/null
+++ b/lisp/progmodes/which-func.el
@@ -0,0 +1,256 @@
+;;; which-func.el --- print current function in mode line
+
+;; Copyright (C) 1994, 1997, 1998, 2001, 2003 Free Software Foundation, Inc.
+
+;; Author:   Alex Rezinsky <alexr@msil.sps.mot.com>
+;;           (doesn't seem to be responsive any more)
+;; Keywords: mode-line, imenu, tools
+
+;; 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 2, 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, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This package prints name of function where your current point is
+;; located in mode line. It assumes that you work with imenu package
+;; and imenu--index-alist is up to date.
+
+;; KNOWN BUGS
+;; ----------
+;; Really this package shows not "function where the current point is
+;; located now", but "nearest function which defined above the current
+;; point". So if your current point is located after end of function
+;; FOO but before begin of function BAR, FOO will be displayed in mode
+;; line.
+;; - if two windows display the same buffer, both windows
+;;   show the same `which-func' information.
+
+;; TODO LIST
+;; ---------
+;;     1. Dependence on imenu package should be removed.  Separate
+;; function determination mechanism should be used to determine the end
+;; of a function as well as the beginning of a function.
+;;     2. This package should be realized with the help of overlay
+;; properties instead of imenu--index-alist variable.
+
+;;; History:
+
+;; THANKS TO
+;; ---------
+;; Per Abrahamsen   <abraham@iesd.auc.dk>
+;;     Some ideas (inserting  in mode-line,  using of post-command  hook
+;;     and toggling this  mode) have  been   borrowed from  his  package
+;;     column.el
+;; Peter Eisenhauer <pipe@fzi.de>
+;;     Bug fixing in case nested indexes.
+;; Terry Tateyama   <ttt@ursa0.cs.utah.edu>
+;;     Suggestion to use find-file-hook for first imenu
+;;     index building.
+
+;;; Code:
+
+;; Variables for customization
+;; ---------------------------
+;;
+(defvar which-func-unknown "???"
+  "String to display in the mode line when current function is unknown.")
+
+(defgroup which-func nil
+  "Mode to display the current function name in the modeline."
+  :group 'tools
+  :version "20.3")
+
+(defcustom which-func-modes
+  '(emacs-lisp-mode c-mode c++-mode perl-mode cperl-mode makefile-mode
+		    sh-mode fortran-mode f90-mode)
+  "List of major modes for which Which Function mode should be used.
+For other modes it is disabled.  If this is equal to t,
+then Which Function mode is enabled in any major mode that supports it."
+  :group 'which-func
+  :type '(choice (const :tag "All modes" t)
+		 (repeat (symbol :tag "Major mode"))))
+
+(defcustom which-func-non-auto-modes nil
+  "List of major modes where Which Function mode is inactive till Imenu is used.
+This means that Which Function mode won't really do anything
+until you use Imenu, in these modes.  Note that files
+larger than `which-func-maxout' behave in this way too;
+Which Function mode doesn't do anything until you use Imenu."
+  :group 'which-func
+  :type '(repeat (symbol :tag "Major mode")))
+
+(defcustom which-func-maxout 500000
+  "Don't automatically compute the Imenu menu if buffer is this big or bigger.
+Zero means compute the Imenu menu regardless of size."
+  :group 'which-func
+  :type 'integer)
+
+(defcustom which-func-format '("[" which-func-current "]")
+  "Format for displaying the function in the mode line."
+  :group 'which-func
+  :type 'sexp)
+;;;###autoload (put 'which-func-format 'risky-local-variable t)
+
+(defvar which-func-cleanup-function nil
+  "Function to transform a string before displaying it in the mode line.
+The function is called with one argument, the string to display.
+Its return value is displayed in the modeline.
+If nil, no function is called.  The default value is nil.
+
+This feature can be useful if Imenu is set up to make more
+detailed entries (e.g., containing the argument list of a function),
+and you want to simplify them for the mode line
+\(e.g., removing the parameter list to just have the function name.)")
+
+;;; Code, nothing to customize below here
+;;; -------------------------------------
+;;;
+(require 'imenu)
+
+(defvar which-func-table (make-hash-table :test 'eq :weakness 'key))
+
+(defconst which-func-current
+  '(:eval (gethash (selected-window) which-func-table which-func-unknown)))
+;;;###autoload (put 'which-func-current 'risky-local-variable t)
+
+(defvar which-func-mode nil
+  "Non-nil means display current function name in mode line.
+This makes a difference only if `which-function-mode' is non-nil.")
+(make-variable-buffer-local 'which-func-mode)
+;;(put 'which-func-mode 'permanent-local t)
+
+(add-hook 'find-file-hook 'which-func-ff-hook t)
+
+(defun which-func-ff-hook ()
+  "File find hook for Which Function mode.
+It creates the Imenu index for the buffer, if necessary."
+  (setq which-func-mode
+	(and which-function-mode
+	     (or (eq which-func-modes t)
+		 (member major-mode which-func-modes))))
+
+  (condition-case nil
+      (if (and which-func-mode
+	       (not (member major-mode which-func-non-auto-modes))
+	       (or (null which-func-maxout)
+		   (< buffer-saved-size which-func-maxout)
+		   (= which-func-maxout 0)))
+	  (setq imenu--index-alist
+		(save-excursion (funcall imenu-create-index-function))))
+    (error
+     (setq which-func-mode nil))))
+
+(defun which-func-update ()
+  ;; "Update the Which-Function mode display for all windows."
+  ;; (walk-windows 'which-func-update-1 nil 'visible))
+  (which-func-update-1 (selected-window)))
+
+(defun which-func-update-1 (window)
+  "Update the Which-Function mode display for window WINDOW."
+  (with-selected-window window
+    (when which-func-mode
+      (condition-case info
+	  (let ((current (which-function)))
+	    (unless (equal current (gethash window which-func-table))
+	      (puthash window current which-func-table)
+	      (force-mode-line-update)))
+	(error
+	 (which-func-mode -1)
+	 (error "Error in which-func-update: %s" info))))))
+
+;;;###autoload
+(defalias 'which-func-mode 'which-function-mode)
+
+(defvar which-func-update-timer nil)
+
+;; This is the name people would normally expect.
+;;;###autoload
+(define-minor-mode which-function-mode
+  "Toggle Which Function mode, globally.
+When Which Function mode is enabled, the current function name is
+continuously displayed in the mode line, in certain major modes.
+
+With prefix ARG, turn Which Function mode on iff arg is positive,
+and off otherwise."
+  :global t :group 'which-func
+  (if which-function-mode
+      ;;Turn it on
+      (progn
+        (setq which-func-update-timer
+              (run-with-idle-timer idle-update-delay t 'which-func-update))
+        (dolist (buf (buffer-list))
+          (with-current-buffer buf
+            (setq which-func-mode
+                  (or (eq which-func-modes t)
+                      (member major-mode which-func-modes))))))
+    ;; Turn it off
+    (cancel-timer which-func-update-timer)
+    (setq which-func-update-timer nil)
+    (dolist (buf (buffer-list))
+      (with-current-buffer buf (setq which-func-mode nil)))))
+
+(defvar which-function-imenu-failed nil
+  "Locally t in a buffer if `imenu--make-index-alist' found nothing there.")
+
+(defun which-function ()
+  "Return current function name based on point.
+Uses `imenu--index-alist' or `add-log-current-defun-function'.
+If no function name is found, return nil."
+  (let (name)
+    ;; If Imenu is loaded, try to make an index alist with it.
+    (when (and (boundp 'imenu--index-alist) (null imenu--index-alist)
+	       (null which-function-imenu-failed))
+      (imenu--make-index-alist)
+      (unless imenu--index-alist
+	(make-local-variable 'which-function-imenu-failed)
+	(setq which-function-imenu-failed t)))
+    ;; If we have an index alist, use it.
+    (when (and (boundp 'imenu--index-alist) imenu--index-alist)
+      (let ((alist imenu--index-alist)
+            (minoffset (point-max))
+            offset elem pair mark)
+        (while alist
+          (setq elem  (car-safe alist)
+                alist (cdr-safe alist))
+          ;; Elements of alist are either ("name" . marker), or
+          ;; ("submenu" ("name" . marker) ... ).
+          (unless (listp (cdr elem))
+              (setq elem (list elem)))
+          (while elem
+            (setq pair (car elem)
+                  elem (cdr elem))
+            (and (consp pair)
+                 (number-or-marker-p (setq mark (cdr pair)))
+                 (if (>= (setq offset (- (point) mark)) 0)
+                     (if (< offset minoffset) ; find the closest item
+                         (setq minoffset offset
+                               name (car pair)))
+                   ;; Entries in order, so can skip all those after point.
+                   (setq elem nil)))))))
+    ;; Try using add-log support.
+    (when (and (null name) (boundp 'add-log-current-defun-function)
+	       add-log-current-defun-function)
+      (setq name (funcall add-log-current-defun-function)))
+    ;; Filter the name if requested.
+    (when name
+      (if which-func-cleanup-function
+	  (funcall which-func-cleanup-function name)
+	name))))
+
+(provide 'which-func)
+
+;;; which-func.el ends here
diff --git a/lisp/textmodes/enriched.el b/lisp/textmodes/enriched.el
new file mode 100644
index 00000000000..e74cb6b8ba7
--- /dev/null
+++ b/lisp/textmodes/enriched.el
@@ -0,0 +1,474 @@
+;;; enriched.el --- read and save files in text/enriched format
+
+;; Copyright (c) 1994, 1995, 1996, 2002 Free Software Foundation, Inc.
+
+;; Author: Boris Goldowsky <boris@gnu.org>
+;; Keywords: wp, faces
+
+;; 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 2, 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, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This file implements reading, editing, and saving files with
+;; text-properties such as faces, levels of indentation, and true line
+;; breaks distinguished from newlines just used to fit text into the window.
+
+;; The file format used is the MIME text/enriched format, which is a
+;; standard format defined in internet RFC 1563.  All standard annotations
+;; are supported except for <smaller> and <bigger>, which are currently not
+;; possible to display.
+
+;; A separate file, enriched.doc, contains further documentation and other
+;; important information about this code.  It also serves as an example
+;; file in text/enriched format.  It should be in the etc directory of your
+;; emacs distribution.
+
+;;; Code:
+
+(provide 'enriched)
+
+;;;
+;;; Variables controlling the display
+;;;
+
+(defgroup enriched nil
+  "Read and save files in text/enriched format"
+  :group 'wp)
+
+(defcustom enriched-verbose t
+  "*If non-nil, give status messages when reading and writing files."
+  :type 'boolean
+  :group 'enriched)
+
+;;;
+;;; Set up faces & display table
+;;;
+
+;; Emacs doesn't have a "fixed" face by default, since all faces currently
+;; have to be fixed-width.  So we just pick one that looks different from the
+;; default.
+(defface fixed
+  '((t (:weight bold)))
+  "Face used for text that must be shown in fixed width.
+Currently, emacs can only display fixed-width fonts, but this may change.
+This face is used for text specifically marked as fixed-width, for example
+in text/enriched files."
+  :group 'enriched)
+
+(defface excerpt
+  '((t (:slant italic)))
+  "Face used for text that is an excerpt from another document.
+This is used in Enriched mode for text explicitly marked as an excerpt."
+  :group 'enriched)
+
+(defconst enriched-display-table (or (copy-sequence standard-display-table)
+				     (make-display-table)))
+(aset enriched-display-table ?\f (make-vector (1- (frame-width)) ?-))
+
+(defconst enriched-par-props '(left-margin right-margin justification)
+  "Text-properties that usually apply to whole paragraphs.
+These are set front-sticky everywhere except at hard newlines.")
+
+;;;
+;;; Variables controlling the file format
+;;;   (bidirectional)
+
+(defconst enriched-initial-annotation
+  (lambda ()
+    (format "Content-Type: text/enriched\nText-Width: %d\n\n"
+	    fill-column))
+  "What to insert at the start of a text/enriched file.
+If this is a string, it is inserted.  If it is a list, it should be a lambda
+expression, which is evaluated to get the string to insert.")
+
+(defconst enriched-annotation-format "<%s%s>"
+  "General format of enriched-text annotations.")
+
+(defconst enriched-annotation-regexp "<\\(/\\)?\\([-A-Za-z0-9]+\\)>"
+  "Regular expression matching enriched-text annotations.")
+
+(defconst enriched-translations
+  '((face          (bold-italic "bold" "italic")
+		   (bold        "bold")
+		   (italic      "italic")
+		   (underline   "underline")
+		   (fixed       "fixed")
+		   (excerpt     "excerpt")
+		   (default     )
+		   (nil         enriched-encode-other-face))
+    (left-margin   (4           "indent"))
+    (right-margin  (4           "indentright"))
+    (justification (none        "nofill")
+		   (right       "flushright")
+		   (left        "flushleft")
+		   (full        "flushboth")
+		   (center      "center"))
+    (PARAMETER     (t           "param")) ; Argument of preceding annotation
+    ;; The following are not part of the standard:
+    (FUNCTION      (enriched-decode-foreground "x-color")
+		   (enriched-decode-background "x-bg-color")
+		   (enriched-decode-display-prop "x-display"))
+    (read-only     (t           "x-read-only"))
+    (display	   (nil		enriched-handle-display-prop))
+    (unknown       (nil         format-annotate-value))
+;   (font-size     (2           "bigger")       ; unimplemented
+;		   (-2          "smaller"))
+)
+  "List of definitions of text/enriched annotations.
+See `format-annotate-region' and `format-deannotate-region' for the definition
+of this structure.")
+
+(defconst enriched-ignore
+  '(front-sticky rear-nonsticky hard)
+  "Properties that are OK to ignore when saving text/enriched files.
+Any property that is neither on this list nor dealt with by
+`enriched-translations' will generate a warning.")
+
+;;; Internal variables
+
+
+(defcustom enriched-mode-hook nil
+  "Hook run after entering/leaving Enriched mode.
+If you set variables in this hook, you should arrange for them to be restored
+to their old values if you leave Enriched mode.  One way to do this is to add
+them and their old values to `enriched-old-bindings'."
+  :type 'hook
+  :group 'enriched)
+
+(defvar enriched-old-bindings nil
+  "Store old variable values that we change when entering mode.
+The value is a list of \(VAR VALUE VAR VALUE...).")
+(make-variable-buffer-local 'enriched-old-bindings)
+
+;;;
+;;; Define the mode
+;;;
+
+(put 'enriched-mode 'permanent-local t)
+;;;###autoload
+(define-minor-mode enriched-mode
+  "Minor mode for editing text/enriched files.
+These are files with embedded formatting information in the MIME standard
+text/enriched format.
+Turning the mode on runs `enriched-mode-hook'.
+
+More information about Enriched mode is available in the file
+etc/enriched.doc in the Emacs distribution directory.
+
+Commands:
+
+\\{enriched-mode-map}"
+  nil " Enriched" nil
+  (cond ((null enriched-mode)
+	 ;; Turn mode off
+	 (setq buffer-file-format (delq 'text/enriched buffer-file-format))
+	 ;; restore old variable values
+	 (while enriched-old-bindings
+	   (set (pop enriched-old-bindings) (pop enriched-old-bindings))))
+
+	((memq 'text/enriched buffer-file-format)
+	 ;; Mode already on; do nothing.
+	 nil)
+
+	(t				; Turn mode on
+	 (push 'text/enriched buffer-file-format)
+	 ;; Save old variable values before we change them.
+	 ;; These will be restored if we exit Enriched mode.
+	 (setq enriched-old-bindings
+	       (list 'buffer-display-table buffer-display-table
+		     'indent-line-function indent-line-function
+		     'default-text-properties default-text-properties))
+	 (make-local-variable 'indent-line-function)
+	 (make-local-variable 'default-text-properties)
+	 (setq indent-line-function 'indent-to-left-margin ;WHY??  -sm
+	       buffer-display-table  enriched-display-table)
+	 (use-hard-newlines 1 nil)
+	 (let ((sticky (plist-get default-text-properties 'front-sticky))
+	       (p enriched-par-props))
+	   (dolist (x p)
+	     (add-to-list 'sticky x))
+	   (if sticky
+	       (setq default-text-properties
+		     (plist-put default-text-properties
+				'front-sticky sticky)))))))
+
+;;;
+;;; Keybindings
+;;;
+
+(defvar enriched-mode-map nil
+  "Keymap for Enriched mode.")
+
+(if (null enriched-mode-map)
+    (fset 'enriched-mode-map (setq enriched-mode-map (make-sparse-keymap))))
+
+(if (not (assq 'enriched-mode minor-mode-map-alist))
+    (setq minor-mode-map-alist
+	  (cons (cons 'enriched-mode enriched-mode-map)
+		minor-mode-map-alist)))
+
+(define-key enriched-mode-map "\C-a" 'beginning-of-line-text)
+(define-key enriched-mode-map "\C-m" 'reindent-then-newline-and-indent)
+(define-key enriched-mode-map "\C-j" 'reindent-then-newline-and-indent)
+(define-key enriched-mode-map "\M-j" 'facemenu-justification-menu)
+(define-key enriched-mode-map "\M-S" 'set-justification-center)
+(define-key enriched-mode-map "\C-x\t" 'increase-left-margin)
+(define-key enriched-mode-map "\C-c\C-l" 'set-left-margin)
+(define-key enriched-mode-map "\C-c\C-r" 'set-right-margin)
+
+;;;
+;;; Some functions dealing with text-properties, especially indentation
+;;;
+
+(defun enriched-map-property-regions (prop func &optional from to)
+  "Apply a function to regions of the buffer based on a text property.
+For each contiguous region of the buffer for which the value of PROPERTY is
+eq, the FUNCTION will be called.  Optional arguments FROM and TO specify the
+region over which to scan.
+
+The specified function receives three arguments: the VALUE of the property in
+the region, and the START and END of each region."
+  (save-excursion
+    (save-restriction
+      (if to (narrow-to-region (point-min) to))
+      (goto-char (or from (point-min)))
+      (let ((begin (point))
+	    end
+	    (marker (make-marker))
+	    (val (get-text-property (point) prop)))
+	(while (setq end (text-property-not-all begin (point-max) prop val))
+	  (move-marker marker end)
+	  (funcall func val begin (marker-position marker))
+	  (setq begin (marker-position marker)
+		val (get-text-property marker prop)))
+	(if (< begin (point-max))
+	    (funcall func val begin (point-max)))))))
+
+(put 'enriched-map-property-regions 'lisp-indent-hook 1)
+
+(defun enriched-insert-indentation (&optional from to)
+  "Indent and justify each line in the region."
+  (save-excursion
+    (save-restriction
+      (if to (narrow-to-region (point-min) to))
+      (goto-char (or from (point-min)))
+      (if (not (bolp)) (forward-line 1))
+      (while (not (eobp))
+	(if (eolp)
+	    nil ; skip blank lines
+	  (indent-to (current-left-margin))
+	  (justify-current-line t nil t))
+	(forward-line 1)))))
+
+;;;
+;;; Encoding Files
+;;;
+
+;;;###autoload
+(defun enriched-encode (from to orig-buf)
+  (if enriched-verbose (message "Enriched: encoding document..."))
+  (save-restriction
+    (narrow-to-region from to)
+    (delete-to-left-margin)
+    (unjustify-region)
+    (goto-char from)
+    (format-replace-strings '(("<" . "<<")))
+    (format-insert-annotations
+     (format-annotate-region from (point-max) enriched-translations
+			     'enriched-make-annotation enriched-ignore))
+    (goto-char from)
+    (insert (if (stringp enriched-initial-annotation)
+		enriched-initial-annotation
+	      (save-excursion
+		;; Eval this in the buffer we are annotating.  This
+		;; fixes a bug which was saving incorrect File-Width
+		;; information, since we were looking at local
+		;; variables in the wrong buffer.
+		(if orig-buf (set-buffer orig-buf))
+		(funcall enriched-initial-annotation))))
+    (enriched-map-property-regions 'hard
+      (lambda (v b e)
+	(if (and v (= ?\n (char-after b)))
+	    (progn (goto-char b) (insert "\n"))))
+      (point) nil)
+    (if enriched-verbose (message nil))
+    ;; Return new end.
+    (point-max)))
+
+(defun enriched-make-annotation (internal-ann positive)
+  "Format an annotation INTERNAL-ANN.
+INTERNAL-ANN may be a string, for a flag, or a list of the form (PARAM VALUE).
+If POSITIVE is non-nil, this is the opening annotation;
+if nil, the matching close."
+  (cond ((stringp internal-ann)
+	 (format enriched-annotation-format (if positive "" "/") internal-ann))
+	;; Otherwise it is an annotation with parameters, represented as a list
+	(positive
+	 (let ((item (car internal-ann))
+	       (params (cdr internal-ann)))
+	   (concat (format enriched-annotation-format "" item)
+		   (mapconcat (lambda (i) (concat "<param>" i "</param>"))
+			      params ""))))
+	(t (format enriched-annotation-format "/" (car internal-ann)))))
+
+(defun enriched-encode-other-face (old new)
+  "Generate annotations for random face change.
+One annotation each for foreground color, background color, italic, etc."
+  (cons (and old (enriched-face-ans old))
+	(and new (enriched-face-ans new))))
+
+(defun enriched-face-ans (face)
+  "Return annotations specifying FACE.
+FACE may be a list of faces instead of a single face;
+it can also be anything allowed as an element of a list
+which can be the value of the `face' text property."
+  (cond ((and (consp face) (eq (car face) 'foreground-color))
+	 (list (list "x-color" (cdr face))))
+	((and (consp face) (eq (car face) 'background-color))
+	 (list (list "x-bg-color" (cdr face))))
+	((and (listp face) (eq (car face) :foreground))
+	 (list (list "x-color" (cadr face))))
+	((and (listp face) (eq (car face) :background))
+	 (list (list "x-bg-color" (cadr face))))
+	((listp face)
+	 (apply 'append (mapcar 'enriched-face-ans face)))
+	((let* ((fg (face-attribute face :foreground))
+		(bg (face-attribute face :background))
+		(props (face-font face t))
+		(ans (cdr (format-annotate-single-property-change
+			   'face nil props enriched-translations))))
+	   (unless (eq fg 'unspecified)
+	     (setq ans (cons (list "x-color" fg) ans)))
+	   (unless (eq bg 'unspecified)
+	     (setq ans (cons (list "x-bg-color" bg) ans)))
+	   ans))))
+
+;;;
+;;; Decoding files
+;;;
+
+;;;###autoload
+(defun enriched-decode (from to)
+  (if enriched-verbose (message "Enriched: decoding document..."))
+  (use-hard-newlines 1 'never)
+  (save-excursion
+    (save-restriction
+      (narrow-to-region from to)
+      (goto-char from)
+
+      ;; Deal with header
+      (let ((file-width (enriched-get-file-width)))
+	(enriched-remove-header)
+
+	;; Deal with newlines
+	(while (search-forward-regexp "\n\n+" nil t)
+	  (if (current-justification)
+	      (delete-char -1))
+	  (set-hard-newline-properties (match-beginning 0) (point)))
+
+	;; Translate annotations
+	(format-deannotate-region from (point-max) enriched-translations
+				  'enriched-next-annotation)
+
+	;; Indent or fill the buffer
+	(cond (file-width		; File was filled to this width
+	       (setq fill-column file-width)
+	       (if enriched-verbose (message "Indenting..."))
+	       (enriched-insert-indentation))
+	      (t			; File was not filled.
+	       (if enriched-verbose (message "Filling paragraphs..."))
+	       (fill-region (point-min) (point-max))))
+	(if enriched-verbose (message nil)))
+      (point-max))))
+
+(defun enriched-next-annotation ()
+  "Find and return next text/enriched annotation.
+Any \"<<\" strings encountered are converted to \"<\".
+Return value is \(begin end name positive-p), or nil if none was found."
+  (while (and (search-forward "<" nil 1)
+	      (progn (goto-char (match-beginning 0))
+		     (not (looking-at enriched-annotation-regexp))))
+    (forward-char 1)
+    (if (= ?< (char-after (point)))
+	(delete-char 1)
+      ;; A single < that does not start an annotation is an error,
+      ;; which we note and then ignore.
+      (message "Warning: malformed annotation in file at %s"
+	       (1- (point)))))
+  (if (not (eobp))
+      (let* ((beg (match-beginning 0))
+	     (end (match-end 0))
+	     (name (downcase (buffer-substring
+			      (match-beginning 2) (match-end 2))))
+	     (pos (not (match-beginning 1))))
+	(list beg end name pos))))
+
+(defun enriched-get-file-width ()
+  "Look for file width information on this line."
+  (save-excursion
+    (if (search-forward "Text-Width: " (+ (point) 1000) t)
+	(read (current-buffer)))))
+
+(defun enriched-remove-header ()
+  "Remove file-format header at point."
+  (while (looking-at "^[-A-Za-z]+: .*\n")
+    (delete-region (point) (match-end 0)))
+  (if (looking-at "^\n")
+      (delete-char 1)))
+
+(defun enriched-decode-foreground (from to &optional color)
+  (if color
+      (list from to 'face (list ':foreground color))
+    (message "Warning: no color specified for <x-color>")
+    nil))
+
+(defun enriched-decode-background (from to &optional color)
+  (if color
+      (list from to 'face (list ':background color))
+    (message "Warning: no color specified for <x-bg-color>")
+    nil))
+
+;;; Handling the `display' property.
+
+
+(defun enriched-handle-display-prop (old new)
+  "Return a list of annotations for a change in the `display' property.
+OLD is the old value of the property, NEW is the new value.  Value
+is a list `(CLOSE OPEN)', where CLOSE is a list of annotations to
+close and OPEN a list of annotations to open.  Each of these lists
+has the form `(ANNOTATION PARAM ...)'."
+  (let ((annotation "x-display")
+	(param (prin1-to-string (or old new))))
+    (if (null old)
+        (cons nil (list (list annotation param)))
+      (cons (list (list annotation param)) nil))))
+
+(defun enriched-decode-display-prop (start end &optional param)
+  "Decode a `display' property for text between START and END.
+PARAM is a `<param>' found for the property.
+Value is a list `(START END SYMBOL VALUE)' with START and END denoting
+the range of text to assign text property SYMBOL with value VALUE "
+  (let ((prop (when (stringp param)
+		(condition-case ()
+		    (car (read-from-string param))
+		  (error nil)))))
+    (unless prop
+      (message "Warning: invalid <x-display> parameter %s" param))
+    (list start end 'display prop)))
+
+;;; enriched.el ends here